以下の内容はhttps://torus711.hatenablog.com/entry/2025/03/24/204354より取得しました。


Haskell で AtCoder ABC 398 A-F

はじめに

 実装中心で.テンプレは別記事

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 が返ってくるなら同じリストにまとめる関数でしたが,リストの要素を指定した関数で変換してそれらの比較結果で同様のことをする groupOnData.List.Extra にあるので,今回はこちらが(必要ならインストールすれば)使えます.
 グループ化ができたら,長さが $1$ であるようなものをだけ取り出して(先ほど reverse していることから)先頭をとれば,その snd が出力するべき値です.長さ $1$ のものだけ取り出すのは filter ( ( == 1 ) . length ) でできるので,あとはこれが空リストかどうかを null で判定して条件分岐すれば問題が解けます.
 解くだけなら以上でよいのですが,今回はワンライナーっぽい形を目指してみます.uncons という関数があって,これはリストが空なら Nothing を,非空なら headtail からなるタプルを 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 などで計算して,その奇遇によって分割すればよいです.ある辺を張ることによって他の辺が張れなくなるようなことはないので,辺の列挙さえしてしまえば,そこから一本ずつ使っていくだけになります.よってやるべきことは

  1. $G$ を適当な頂点から DFS して距離を求める
  2. (1.) の結果を用いて張れる辺を列挙する
  3. (2.) で列挙した本数が奇数なら先攻,偶数なら後攻でゲーム開始
    1. 自分のターンでは,残っている辺から適当なものを一本選んで張る
    2. 相手のターンでは,指定された辺を残っている辺の集まりから削除
      1. 相手が負けを認めた場合は終了

となります.
 (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.SetfromAscList とかで変換しておくと削除操作が高速になります*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'

*1:今回の入力のサイズだとそこまでやる必要は無い気もしてきましたが……

*2:こちらもそこまでやる必要は無い気がして聞きましたが……




以上の内容はhttps://torus711.hatenablog.com/entry/2025/03/24/204354より取得しました。
このページはhttp://font.textar.tv/のウェブフォントを使用してます

不具合報告/要望等はこちらへお願いします。
モバイルやる夫Viewer Ver0.14