はじめに
実装中心で.テンプレは別記事.
A
問題文 : https://atcoder.jp/contests/abc398/tasks/abc398_a
'-' が連続する個数と '=' が連続する個数がどうなるかを考えます.具体例で考えるなどすると,$n$ の奇遇に拘らず
'-'は $\lfloor \frac { n - 1 } 2 \rfloor$ 個'='は $( ( n - 1 ) \bmod 2 ) + 1$ 個
と言えることが分かり,これなら ( n - 1 ) `divMod` 2 でまとめて求められます.あとは replicate で文字列を作って (++) で連結したものを出力してあげればよいです.
main = do n <- readInt let ( lr, c ) = ( flip replicate '-' *** flip replicate '=' . succ ) $ ( n - 1 ) `divMod` 2 putStrLn $ lr ++ c ++ lr
B
問題文 : https://atcoder.jp/contests/abc398/tasks/abc398_b
permutations で並べ方を全通り生成できるので,それぞれ take 5 することで,順序を区別して $5$ 枚選ぶ方法を全通り生成できます.選んだ $5$ 枚がフルハウスになっているかは,そのまま「先頭側の $2$ 枚が同じカードで,末尾側の $3$ 枚が先頭側とは異なる同じカード」であるかどうかを判定することにします.group というのがあって,リスト内で連続する同じ値を一つのリストにまとめた二重リストを作ることができるので,map length で長さに変換して [ 2, 3 ] と等しいかどうかを判定すると達成できます.
リスト内に条件を満たすものがひとつ以上存在するかどうかは any で調べられるので,any の結果で出力文字列を切り替えれば問題が解けます.
main = readInts >>= putStrLn . yesno . any ( ( == [ 2, 3 ] ) . map length . group . take 5 ) . permutations
C
問題文 : https://atcoder.jp/contests/abc398/tasks/abc398_c
値と添え字を関連付けて扱いたいので添字と zip することを考えます.後々,値の最大値をとってきたいので,値の大小とタプルの大小が一致するように flip zip [ 1 .. ] で fst が値,snd が添え字になるようにします.この列を reverse . sort すると,両側の隣接要素のどちらとも fst の値が異なるような要素の snd が答えで,そういうものが存在しなければ答えは -1 です.
B で使った group は詳しく言うと隣接要素を (==) で比較して True が返ってくるなら同じリストにまとめる関数でしたが,リストの要素を指定した関数で変換してそれらの比較結果で同様のことをする groupOn が Data.List.Extra にあるので,今回はこちらが(必要ならインストールすれば)使えます.
グループ化ができたら,長さが $1$ であるようなものをだけ取り出して(先ほど reverse していることから)先頭をとれば,その snd が出力するべき値です.長さ $1$ のものだけ取り出すのは filter ( ( == 1 ) . length ) でできるので,あとはこれが空リストかどうかを null で判定して条件分岐すれば問題が解けます.
解くだけなら以上でよいのですが,今回はワンライナーっぽい形を目指してみます.uncons という関数があって,これはリストが空なら Nothing を,非空なら head と tail からなるタプルを Just に入れて返してくれます.Just 値が返ってきたら,中身に fst を適用した値が値と添字のタプルのリストなので,更に snd . head を適用した値が出力するべき値です.Nothing かどうかで分岐したいですが,maybe という関数があって,既定値,関数,Maybe 値を受け取って,Maybe 値が Nothing なら既定値を,そうでなければ中身に関数を適用した値を返してくれます.なので,uncons の結果に maybe (-1) ( snd . head . fst ) すると出力するべき値になります.
main = getLine >> readInts >>= print . maybe (-1) ( snd . head . fst ) . uncons . filter ( ( == 1 ) . length ) . groupOn fst . reverse . sort . flip zip [ 1 .. ]
D
問題文 : https://atcoder.jp/contests/abc398/tasks/abc398_d
煙全体を動かす代わりに,焚き火とヒトを逆向きに動かすことでシミュレートします.判定は,煙のある座標を Data.Set に入れておけば一回あたり $O( \log n )$ 時間で判定できるので間に合います.よって,焚き火とヒトの座標と Data.Set を引数に含む再帰関数で $S$ を舐めれば問題が解けます.
これはこれでよいのですが,foldl のようなことをしながら,各段階でアキュムレータに応じた値をリストに書き出す mapAccumL というのがあって,今回の場合は,焚き火の位置,ヒトの位置,Data.Set をまとめてひとつのタプルにして,$S$ の文字を受け取る関数として実装すると再帰を mapAccumL に任せることができます.
main = do [ n, y, x ] <- readInts s <- getLine putStrLn $ snd $ mapAccumL solve ( Set.singleton ( 0, 0 ), 0, 0, y, x ) s solve ( set, oy, ox, y, x ) c = ( ( set', oy', ox', y', x' ), if ( y', x' ) `Set.member` set' then '1' else '0' ) where d = fromJust $ elemIndex c "NESW" ( dy, dx ) = ( zip [ -1, 0, 1, 0 ] [ 0, 1, 0, -1 ] ) !! ( ( d + 2 ) `mod` 4 ) oy' = oy + dy ox' = ox + dx y' = y + dy x' = x + dx set' = ( oy', ox' ) `Set.insert` set
D
問題文 : https://atcoder.jp/contests/abc398/tasks/abc398_e
証明はしませんが,グラフ $G$ について
\[
\text{$G$ が奇閉路を含まない} \Leftrightarrow \text{$G$ は二部グラフ}
\]
です.また,木は閉路自体含まないので二部グラフです.よって操作で満たすべき条件は「$G$ を二部グラフのままにしろ」と言い換えられます.よって追加できる辺は(二部グラフの特徴に従って)$G$ の頂点をグループ内部の頂点間に辺が無いような $2$ のグループに分けたときの,異なるグループに属する頂点間に張られる辺です.頂点のグループ分けは,適当な頂点からの距離を DFS などで計算して,その奇遇によって分割すればよいです.ある辺を張ることによって他の辺が張れなくなるようなことはないので,辺の列挙さえしてしまえば,そこから一本ずつ使っていくだけになります.よってやるべきことは
- $G$ を適当な頂点から DFS して距離を求める
- (1.) の結果を用いて張れる辺を列挙する
- (2.) で列挙した本数が奇数なら先攻,偶数なら後攻でゲーム開始
- 自分のターンでは,残っている辺から適当なものを一本選んで張る
- 相手のターンでは,指定された辺を残っている辺の集まりから削除
- 相手が負けを認めた場合は終了
となります.
(1.) をするために入力される辺リストを使いやすいデータ構造に変換したいですが,今回は(今回も?)頂点番号からそこへ接続する辺のリストを引ける配列を作ります.まずは辺を双方向化したいですが,辺リストを replicateM ( n - 1 ) ( map read . words <$> getLine )のような方法で読み込んだとして,\[ u, v ] -> [ ( u, v ), ( v, u ) ] を concatMap すればよいです.地味にリストからタプルに変換しているのは配列の構築に accumArray を使いたいからで,[] を初期値として flip (:) で更新するように accumArray すると欲しい配列ができます.また,既存の辺を張らないように存在判定をしたいですが,隣接行列を作っておくと高速に処理できます*1.こちらの構築も accumArray でできて,False を初期値として (||) で足し込みます.
DFS パートは結果を書き込むためにミュータブル配列が欲しいので,STArray を使います.
(2.) についてはリストの do でやるのがごちゃごちゃしなさそうで,Data.Set に fromAscList とかで変換しておくと削除操作が高速になります*2.
ゲームプレイは上述の通りに入出力をやるだけですが,(普段やらない)バッファのフラッシュをちゃんとやらないと危険があぶないです.フラッシュは System.IO にある hFlush を使います.次ターンと相手ターンを交互に行うのは,相互再帰っぽく実装すればよくて,先手に対応する呼び出しを正しく行えるように気を付けます.
main = do n <- readInt es <- concatMap ( \[ u, v ] -> [ ( u, v ), ( v, u ) ] ) <$> replicateM ( n - 1 ) readInts let graph = accumArray ( flip (:) ) [] ( 1, n ) es matrix = accumArray (||) False ( ( 1, 1 ), ( n, n ) ) $ flip zip ( repeat True ) es ds = dfs graph set = Set.fromAscList $ do i <- [ 1 .. n ] j <- [ i + 1 .. n ] guard $ ( not $ matrix ! ( i, j ) ) && ds ! i `mod` 2 /= ds ! j `mod` 2 return ( i, j ) t = Set.size set `mod` 2 putStrLn $ bool "First" "Second" $ t == 0 hFlush stdout play t set where play 1 set = do let ( i, j ) = Set.elemAt 0 set printList [ i, j ] hFlush stdout play 0 $ Set.delete ( i, j ) set play 0 set = do [ i, j ] <- readInts if ( i, j ) == ( -1, -1 ) then return () else play 1 $ Set.delete ( i, j ) set dfs graph = runSTArray $ do distances <- newArray ( 1, n ) 0 let dfs' d u p = do writeArray distances u d forM_ ( graph ! u ) $ \v -> do when ( v /= p ) $ do dfs' ( succ d ) v u dfs' 0 1 (-1) return distances where ( _, n ) = bounds graph
F
問題文 : https://atcoder.jp/contests/abc398/tasks/abc398_f
文字列 $S$ に対して,$l$ 文字目から $r$ 文字目 ($0$-indexed)を取り出したものを $S[ l, r ]$ と書くことにします.また,文字列 $S$ を反転したものを $S^{ \mathrm R }$ と書くことにします.更に,文字列 $S_1, S_2$ に対して,$S_1$ と $S_2$ を連結してできる文字列を $S_1 \cdot S_2$ と書きます.
自明に回文を作れるケースとしては $S \cdot S^{ \mathrm R }$ がありますが,ちょっとよく考えると,$S \cdot S^{ \mathrm R }[ 2, |S| ]$ も回文になります.一般化するとどうなるか考えると,$S$ の接尾辞と $S^{ \mathrm R }$ の接頭辞が一致していれば「重ねる」ようなことができるということです.$S$ の接尾辞を反転したものが $S^{ \mathrm R }$ の接頭辞なので,$S$ の接尾辞の内で重ねて使えるものとは,それ自体が回文になっているようなもので,それらの内最長のものを使うことで連結後の文字列の長さを最小化できます.
てきとーにぐぐったりすると出てきますが,Manacher's Algorithm といのがあって,文字列中の各文字について「回文半径」を線形時間で求められます.この情報を使うと,各文字を中心とする回文が $S$ の末尾の文字を含むかどうかを(添字とかの)算数で判定できるので,上述の条件を満たす回文の内で最長のものを求めることができます.
実装例(すぬけ先生)などを見てみるとどう見てもミュータブルな感じなので,そのまま実装するには STArray でがんばります.
Manacher's Algorithm をそのまま使うと奇数長の回文しか求められなかったりするのですが,位置文字ごとにダミー文字を挟むことで対応できますダミー文字を挟む処理は intersperse が便利で,出力するときには filter ( /= '$' ) します.
main = do s <- intersperse '$' <$> getLine let n = length s rs = manacher s pos = snd $ maximum $ do i <- [ 1 .. n ] guard $ i - 1 + rs ! i == n return ( ( rs ! i ) * 2 - 1, i ) s' = take ( pos - rs ! pos ) s putStrLn $ filter ( /= '$' ) $ s ++ reverse s' manacher s' = runSTArray $ do res <- newArray ( 1, n ) 0 let rec i j | n < i = return () | 1 <= i - j && i + j <= n && s ! ( i - j ) == s ! ( i + j ) = rec i $ succ j | otherwise = do writeArray res i j k <- rec' 1 rec ( i + k ) ( j - k ) where rec' k | i - k < 1 = return k | otherwise = do rk <- readArray res ( i - k ) if k + rk < j then do writeArray res ( i + k ) rk rec' $ succ k else return k rec 1 0 return res where n = length s' s = listArray ( 1, n ) s'