以下の内容はhttps://torus711.hatenablog.com/entry/2025/04/10/203542より取得しました。


Haskell で AtCoder ABC 400 A-E

はじめに

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

A

 $a$ が $400$ を割り切る場合は $\frac { 400 } a$ を,そうでなければ $-1$ を出力します.divMod で商と剰余を両方得られるので,あとは条件分岐するだけです.

main = do
	( p, q ) <- ( 400 `divMod` ) <$> readInt
	print $ if q == 0
		then p
		else -1

これはこれでいいんですが,A 問題から do を使うのは贅沢ですよね? ということでワンライナー風にしていきましょう.
 ややトリッキーですが,出力するべき値を id pconst -1 p と言い換えます.渡されてくる q の値によって対応する関数を返す関数は bool を使うと bool ( const -1 ) id . ( == 0 ) と書けます.Control.Arrow にある (***) を使って ( id *** bool ( const -1 ) id . ( == 0 ) ) . divMod 400 としてあげれば,関数に渡す値と関数からなるタプルができます.あとは ($) で適用すればいいですが,タプルになっていることと関数と引数の順序が逆になっているのを吸収するために uncurry ( flip ($) ) という形で使います.ということで次のようなコードになりました.

main = readInt >>= print . uncurry ( flip ($) ) . ( id *** bool ( const -1 ) id . ( == 0 ) ) . divMod 400

 コンテスト中とかにこんなことを頑張る必要は……無いですね,はい.

B

 題意としてはおそらく「ループの途中で $10^9$ を超えたらそこで中断する」のようなことを求めている気がしますが,多倍長整数で最後まで求めたとしてとんでもない桁数になるような制約でもないので Integer 型でゴリ押せてしまいます.

main = do
	[ n, m ] <- readIntegers
	let
		s = sum $ do
			i <- [ 0 .. m ]
			return $ n^i
	putStrLn $ if 10^9 < s
		then "inf"
		else show s

C

 詳細は別記事としますが,結論としては
\begin{equation*}
\left\lfloor \sqrt { \frac n 2 } \right\rfloor + \left\lfloor \sqrt { \frac n 4 } \right\rfloor
\end{equation*}
を出力すればよいです.平方根の整数部分を求める関数は標準に無さげなので自作しますが,浮動小数点数平方根を求めてから周辺の整数について調べるという方法で横着してしまってもよいかもしれません.この場合,filter ではなく takeWhile にしないと無限リストを評価しようとして大変なことになるのが注意点でしょうか.

main = do
	n <- readInt
	print $ isqrt ( n `div` 2 ) + isqrt ( n `div` 4 )

isqrt n = last $ takeWhile ( ( <= n ) . (^2) ) [ max 0 $ ( floor $ sqrt $ fromIntegral n ) - 1 .. ]

 一応真面目に二分法するバージョンも書いてみました.Integer として計算しないとオーバーフローする罠が埋め込まれていますが…….

isqrt 1 = 1
isqrt n = isqrt' 0 n n
	where
	isqrt' lb ub n
		| lb + 1 < ub = let mid = ( lb + ub ) `div` 2 in
			if mid * mid <= n
				then isqrt' mid ub n
				else isqrt' lb mid n
		| otherwise = lb

D

 Dijkstra 法で解くことができますが,インスタンスが特殊な場合,漸近的により速い実装が知られています.具体的には,辺のコストが $0$ または単位重み(今回の場合 $1$)のみの場合,順位キューを使った Dijkstra 法における順位キューの動作を Deque で模倣することができて,各操作が均し $O( 1 )$ 時間であることから漸近的に高速です.この実装方法は $01$-BFS とか呼ばれていたりします.
 ということで実装していきますが,色々なところで配列を使います.まず盤面情報は各行を concat してから listArray でイミュータブル配列にしておきます.
 $01$-BFS パートでは各セルへの距離をミュータブル配列でもって計算したいので,STUArray を使います*1.メインの処理は,C++ などで書いたコードから forforM_ に変え,ifwhenwhenM に変えるなどして翻訳する気持ちで実装します.Deque に都度 push するために STRef を使っていますが,あんまり使いたくない気もしつつ使わずには実装できずにいます.
 キューの実装方法としてリストを $2$ 本もつ実装方法が知られていますが,今回の場合末尾からは pop しないので同じ方法で Deque を実装できます.具体的には,

  • 先頭への push, pop はリスト $1$ の先頭を操作
  • 末尾への push はリスト $2$ の先頭を操作

というのが基本方針です.ただし,pop するときにリスト $1$ が空だと困るので,

  • pop するときにリスト $1$ が空なら,リスト $2$ を反転したものを新たなリスト $1$ とし,リスト $2$ は空リストにする

ということをします.push された要素が反転に巻き込まれる回数は高々 $1$ 回であることから,均し $O( 1 )$ 時間になっています*2

main = do
	[ h, w ] <- readInts
	board <- listArray ( ( 1, 1 ), ( h, w ) ) . concat <$> replicateM h readStr
	poss <- readInts
	print $ solve board poss

solve board [ sy, sx, ty, tx ] = runST $ do
	distances <- newArray ( ( 1, 1 ), ( h, w ) ) maxBound :: ST s ( STUArray s ( Int, Int ) Int )
	writeArray distances ( sy, sx ) 0
	let
		zobfs deq = do
			when ( not $ deqnull deq ) $ do
				let
					( ( y, x ), ndeq' ) = pop deq
				ndeq <- newSTRef ndeq'
				forM_ ( zip [ 0, 1, 0, -1 ] [ 1, 0, -1, 0 ] ) $ \( dy, dx ) -> do
					forM_ [ 1, 2 ] $ \d -> do
						let
							ny = y + dy * d
							nx = x + dx * d
							c = max ( d - 1 ) ( bool 0 1 ( board ! ( ny, nx ) == '#' ) )
						nd <- ( + c ) <$> readArray distances ( y, x )
						when ( inside ny nx ) $ do
							whenM ( ( ( nd < ) <$> readArray distances ( ny, nx ) ) ) $ do
								writeArray distances ( ny, nx ) nd
								modifySTRef ndeq ( flip ( bool pushf pushb ( c == 1 ) ) ( ny, nx ) )
				zobfs =<< readSTRef ndeq
	zobfs $ deqsingleton ( sy, sx )
	readArray distances ( ty, tx )
	where
	( h, w ) = snd $ bounds board
	inside y x = 1 <= y && y <= h && 1 <= x && x <= w

deqnull ( [], [] ) = True
deqnull _ = False

deqsingleton a = ( [a], [] )

pop ( [], t ) = pop ( reverse t, [] )
pop ( ( h:hs ), t ) = ( h, ( hs, t ) )

pushf ( h, t ) a = ( a:h, t )

pushb ( h, t ) a = ( h, a:t )

E

 詳細は別記事としますが,$10^6$ 以下の正整数の内で,素因数がちょうど $2$ 種のものを列挙してそれぞれ $2$ 乗しておくと,クエリごとに二分探索のようなことをすれば解くことができます.
 欲しい整数の列挙は,Eratosthenes の篩をしながら,素因数の倍数をマークするときに各倍数に対してカウントアップすることで,各合成数について素因数の個数を求められるので,filter のようなことをすればよいです.ただし,以下の実装では STUArray でカウントしていて個数の読み出しがモナドアクションになるので filterM になります.合成数ごとに素因数の個数を数えている配列を divsCount として,divsCount から読み出した値が $2$ と等しいかどうかが条件なので ( == 2 ) <$> readArray divsCount のようなことをしたいですが.readArray の引数を全て与えていないので型が合いません.( ( == 2 ) <$> ) を関数合成して ( ( ( == 2 ) <$> ) . readArray divsCount ) とするとうまくいきます.
 クエリに答えるための二分探索ですが,Data.Set に入れてしまって lookupLE でやるのが楽そうです.

main = readInt >>= flip replicateM readInt >>= mapM_ print . map ( fromJust . flip Set.lookupLE s )

s = Set.fromList $ map (^2) $ eratosthenes 1000000
	
eratosthenes n = runST $ do
	isPrime <- newArray ( 2, n ) True :: ST s ( STUArray s Int Bool )
	divsCount <- newArray ( 2, n ) 0 :: ST s ( STUArray s Int Int )
	forM_ [ 2 .. n ] $ \i -> do
		whenM ( readArray isPrime i ) $ do
			forM_ ( takeWhile ( ( <= n ) . ( * i ) ) [ 2 .. ] ) $ \j -> do
				writeArray isPrime ( i * j ) False
				modifyArray divsCount ( i * j ) succ
	filterM ( ( ( == 2 ) <$> ) . readArray divsCount ) [ 2 .. n ]

*1:このあたり,手続き型脳から脱却できていないのかも……?

*2:末尾からも pop しようとすると何回反転に巻き込まれるのか保証できない……はず.




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

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