以下の内容はhttps://torus711.hatenablog.com/entry/2026/03/10/192930より取得しました。

Haskell で AtCoder ABC448 A-F

AtCoder Haskell

はじめに

　実装メイン．テンプレは別記事．

A

　問題文 : https://atcoder.jp/contests/abc448/tasks/abc448_a
　$x \overset{ \mathord{ \min } }{ \leftarrow } A_i$ *1 を各 $i = 1, 2, \dots, n$ について順に行う処理は $x$ を初期値として $\mathord{ \min }$ で foldl で畳み込むことに相当します．出力を作るためには畳み込みの各段階で Bool（とか）を書き出す必要がありますが，そういう関数として mapAccumL があります．$x, a$ を受け取って

  • $a$ を作用させた結果 : $\min( x, a )$
  • 出力に対応する Bool 値 : $a < x$

からなるタプルを返す関数を渡すと，畳み込みの結果と，各段階で書き出した値のリストからなるタプルが帰ってきます．よって，snd をとって bool 0 1 を map すると出力するべき値のリストが得られます．
　A としてはちょっと複雑じゃないですか……？

main = do
	[ n, x ] <- readInts
	as <- readInts
	mapM_ print $ map ( bool 0 1 ) $ snd $ mapAccumL solve x as

solve x a = ( min x a, a < x )

B

　問題文 : https://atcoder.jp/contests/abc448/tasks/abc448_b
　在庫のことを一旦忘れれば各料理に対して上限まで使うのが最適で，胡椒 $j$ を
\[
S_j = \sum_{ i \in \{ 1, 2, \dots, n \} \mid A_i = j } B_i
\]
だけ使いたいです．在庫を考慮すると実際に使えるのは $\min( C_j, S_j )$ なので，$C, S$ がリストになっているとして 各 $j$ について $\min( C_j, S_j )$ をとったリストが欲しいです．これは zipWith min で構成でき，更に sum をとれば答えです．
　$S$ の計算が残っていますが，$A_i$ が等しいグループ毎に foldl (+) 0 をすると思うと accumArray で畳み込んでから elems をとると出来上がります．

main = do
	[ n, m ] <- readInts
	cs <- readInts
	ss <- elems . accumArray @UArray (+) 0 ( 1, m ) . map mp <$> replicateM n readInts
	print $ sum $ zipWith min cs ss

C

　問題文 : https://atcoder.jp/contests/abc448/tasks/abc448_c
　$A$ は昇順ソート済みとします．$k$ の制約からクエリの答えになり得るのは $A$ の先頭 $6$ 要素の中にあるので，調べるべき要素の個数を $O( 1 )$ 個にできます．よって，与えられた $B$ を舐めて，$A$ の先頭 $6$ 要素に含まれない最初の要素を愚直に調べることができます．
　実装ですが，$A$ については添え字 $i$ から $A_i$ を高速に参照したいので，listArray で UArray にしておきます．この UArray を as とすると，添え字からなるリストを $A$ の値の昇順に並べ替えて先頭 $6$ 要素をとるのは ixs = take 6 $ sortOn ( as ! ) [ 1 .. n ] でできます．
　クエリ部分はクエリ毎に

  • $1$ 行目に $k$
  • $2$ 行目に $B$

が入力されますが（おそらくは ByteString の）getLine から $B$ を受け取るので $k$ の方は不要です．よって，

  1. $1$ 行読み飛ばす
  2. [Int] を読み込む
  3. 2. の結果を返す

というアクションを replicateM q に渡せば各クエリの $B$ を並べた [[Int]] を読み込めます．そういうアクションは第一引数のアクションの結果を無視して bind する >> を使ってgetLine >> readInts で作れます．
　あとは各クエリの $B$ について，それに含まれない ixs の要素を探してくればよいですが，これは find ( `notElem` bs ) ixs で見つけられます．この結果は（見つからなかった場合に Nothing を返すことで検知できるようにしているので）fromJust と ( as ! ) に通すと答えになります．

main = do
	[ n, q ] <- readInts
	as <- listArray @UArray ( 1, n ) <$> readInts
	bss <- replicateM q ( getLine >> readInts )
	let
		ixs = take 6 $ sortOn ( as ! ) [ 1 .. n ]
	mapM_ print $ map ( ( as ! ) . fromJust ) do
		bs <- bss
		return $ find ( `notElem` bs ) ixs

D

　問題文 : https://atcoder.jp/contests/abc448/tasks/abc448_d
　頂点 $1$ から DFS をして，頂点 $u$ を訪問したときに $A_u$ が $u$ までのパス上で既出かどうかを判定できれば，$u$ 以下の部分木に含まれる頂点に対応する出力を Yes と決定できます．木に対する DFS というと条件反射的に木 DP と言われがちな風潮がある[要出典]気がしますが，今回のように各頂点を高々 $1$ 回しか訪問しない場合は値をメモしても再利用されることがないのでメモ化（DP 化）は不要です．
　ということで DFS をする関数を設計します．引数にはグラフ自体や現在位置（頂点）の他に，そこまでのパス上にあった整数を入れた Data.IntSet を受け取るようにして判定に使います．戻り値をどうするかはいくつか選択肢がある気がしますが，ここでは「現在地以下の部分木の内，答えが No になる頂点からなる Data.IntSet」を返すことにします．一度 Yes になったらそれ以下の部分木の頂点でもすべて Yes なので，上記のように取り決めると探索を打ち切ることができますし，祖先での結果を伝播させてくる必要も無くなります．
　実装の細かいところですが，DFS の引数の内，訪問する頂点を最後に受け取るようにすると子のリストに対して自然に map できて，map の結果は [IntSet] なので集計も IntSet.unions で一発になります．

main = do
	n <- readInt
	as <- listArray @UArray ( 1, n ) <$> readInts
	graph <- accumArray @Array ( flip (:) ) [] ( 1, n ) . concat <$> replicateM ( n - 1 ) do
		[ u, v ] <- readInts
		return [ ( u, v ), ( v, u ) ]
	let
		s = dfs graph as ISet.empty 0 1
	mapM_ ( putStrLn . yesno . ( flip ISet.notMember s ) ) [ 1 .. n ]

dfs graph as s p u = if r
	then ISet.empty
	else chs
	where
	a = as ! u
	r = ISet.member a s
	s' = ISet.insert a s
	chs = ISet.insert u $ ISet.unions $ map ( dfs graph as s' u ) $ filter ( /= p ) ( graph ! u )

E

　問題文 : https://atcoder.jp/contests/abc448/tasks/abc448_e
　別記事と同様のものを実装します．つまり，レピュニットを $2$ 冪のレピュニットの連結として反復二乗法っぽく構成することで高速化します．
　とりあえず，実行時に法が決まる剰余環は自分で実装する必要がある気がするので，必要な演算子のみ実装します．ここでは和・積・冪乗を実装しますが，演算子の定義だけ書いても結合の優先度が全部同じになってしまって使いづらいので，（あんまり書かないので毎回忘れてｇｇるのですが）infixl で結合性と優先度を宣言してやります．優先度は元々ある +, *, ^ に合わせると $6, 7, 8$ なので，例えば以下のようになります．

infixl 6 +%
a +% b = ( a + b ) `mod` modulus
infixl 7 *%
a *% b = ( a * b ) `mod` modulus
infixl 8 ^%
a ^% b = foldl (*%) 1 do
	( i, a ) <- takeWhile ( ( <= b ) . ( 1 .<<. ) . fst ) $ zip [ 0 .. ] $ iterate ( ( `mod` modulus ) . (^2) ) a
	guard $ b .&. 1 .<<. i /= 0
	return $ a

冪乗がちょっとアレなことになっていますが，これは反復二乗法です．$2$ 冪の指数と実際の $2$ 冪のペアにしてから必要な部分を filter（実装は guard ですが）して総積をとっています．ビットシフトをさらっと使っていますが，ビット演算は Data.Bits に色々あるので便利です．演算子の見た目がちょっとキモいですが……．
　本質部分の実装はなかなかつらめだったのですが，まず，$a$ を $2^i$ 個重ねたレピュニットを $2^{ i + 1 }$ 個重ねたレピュニットにする関数は
\[
( a, i ) \mapsto a \times 10^{ 2^i } + a
\]
です．これで scanl をすると長さ $2^i$ ($i = 0, 1, 2, \dots$) のレピュニットからなるリストを作ることができて，$0, 1, \dots, 9$ に対してそれぞれ作ってミュータブル配列に変換しておくと高速に参照できるようになります．この結果を使ってまたしても反復二乗法のように必要な桁数のレピュニットだけ集めてきて連結することで任意の桁数のレピュニットを作ることができ，似たような関数での畳み込みで答えも計算できます．

main = do
	[ k, m ] <- readInts
	[ cs, ls ] <- transpose <$> replicateM k readInts
	let
		modulus = 10_007 * m
		infixl 6 +%; a +% b = ( a + b ) `mod` modulus
		infixl 7 *%; a *% b = ( a * b ) `mod` modulus
		infixl 8 ^%; a ^% b = foldl (*%) 1 do
			( i, a ) <- takeWhile ( ( <= b ) . ( 1 .<<. ) . fst ) $ zip [ 0 .. ] $ iterate ( ( `mod` modulus ) . (^2) ) a
			guard $ b .&. 1 .<<. i /= 0
			return $ a
		twice a i = a *% 10^%( 1 .<<. i :: Int ) +% a
		dp = listArray @UArray ( ( 0, 0 ), ( 9, 30 ) ) $ concat $ map ( flip ( scanl twice ) [ 0 .. 29 ] ) [ 0 .. 9 ]
		repunit c l = foldl repunit' 0 [ i | i <- [ 0 .. 30 ], l .&. 1 .<<. i /= 0 ]
			where
			repunit' a i = a *% 10^%( 1 .<<. i :: Int ) +% dp ! ( c, i )
		solve a ( c, l ) = a *% 10^%l +% repunit c l
	print $ ( `div` m ) $ foldl solve 0 $ zip cs ls

F

　問題文 : https://atcoder.jp/contests/abc448/tasks/abc448_f
　公式解説と同じことをします．すなわち，$x$ 座標について適当なブロック幅で分割してから，ブロック毎にソートします．分割部分は accumArray ( flip (:) ) [] で実装できます．
　ソートはブロックが奇数番目か偶数番目かによって昇順・降順が切り替わるのでちょっと工夫します．この切り替わりを言い換えると一旦全部昇順にしてから奇数番目に id を，偶数番目に reverse を適用する，と言えます．cycle [ id, reverse ] で id と reverse が交互に出現する無限リストを作れるので，zipWith ($) をすると欲しかったものが手に入ります．
　あとは，concat してから $1$ の位置*2を fromJust . elemIndex で求めて，splitAt で分割してから繋ぎ直すと答えになります．

main = do
	n <- readInt
	ps <- replicateM n readInts
	let
		w = round $ ( fromIntegral 30_000_000 ) / sqrt ( fromIntegral n )
		b = ( 30_000_000 + w - 1 ) `div` w
		columns = elems $ accumArray @Array ( flip (:) ) [] ( 0, b ) do
			( i, [ x, y ] ) <- zip [ 1 .. ] ps
			return $ ( x `div` w, ( y, i ) )
		res = map snd $ concat $ zipWith ($) ( cycle [ id, reverse ] ) $ map sort columns
		ix = fromJust $ elemIndex 1 res
		( res1, res2 ) = splitAt ix res
	printList $ res2 ++ res1

*1:$a \overset{ \mathord{ \min } } \leftarrow b := a \leftarrow \min( a, b )$ とする

*2:おもしろギャグ



以上の内容はhttps://torus711.hatenablog.com/entry/2026/03/10/192930より取得しました。
このページはhttp://font.textar.tv/のウェブフォントを使用してます
不具合報告/要望等はこちらへお願いします。
モバイルやる夫Viewer Ver0.14