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


Haskell で AtCoder ABC 397 A-E

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

A

 問題文 : https://atcoder.jp/contests/abc397/tasks/abc397_a
 小数点を削除して整数として受け取ってから条件分岐するなど丁寧にやってもよいですが,このフォーマットだと文字列の(辞書式順序における)大小とそれが表現する数値の大小が一致することを利用して簡略化できます.
 また,温度区分の区切りを高温側から順に舐めて,$X$ より大きければ次を試すという気持ちになると,入力文字列を s としてリスト [ "38.0", "37.5" ] から ( s < )takeWhile できる要素数に $1$ を足した値が出力値に対応します.
 takeWhile の引数の順序を flip で入れ替えてあげると predictor を受け取る関数を作れるのでワンライナーにできます.

main = getLine >>= print . succ . length . flip takeWhile [ "38.0", "37.5" ] . (<)

B

 問題文 : https://atcoder.jp/contests/abc397/tasks/abc397_b
 作りたい文字列の偶数文字目・奇数文字目に関する性質を「同じ文字が連続しない」と言い換えると,入力文字列において同じ文字が隣接している箇所に他方の文字を挿入することで条件を満たせることに気付きます.そこで,group で同じ文字が連続する極大な部分に分解することを考えます.同じ文字が $l$ 個連続する部分には $l - 1$ 文字挿入すればよいので,pred . lengthmap して和をとれば,同じ文字が連続しないようにするための操作回数が分かります.
 上記の挿入操作は入力文字列の先頭・末尾の文字を変化させないので,先頭が 'o' である場合と末尾が 'i' である場合にはそれぞれ追加で $1$ 文字挿入することで,最小コストで目標を達成できます.

main = do
	s <- getLine
	print $ ( sum $ map ( pred . length ) $ group s )
		+ ( bool 0 1 $ head s == 'o' )
		+ ( bool 0 1 $ last s == 'i' )

C

 問題文 : https://atcoder.jp/contests/abc397/tasks/abc397_c
 各 $i \in \{ 0, 1, \dots, n \}$ について左から $i$ 個を取り出したときの種類数を $L_i$ とします.$L = \langle L_0, L_1, \dots, L_n \rangle$ を求めるアルゴリズムを入力を逆順にした列に適用すれば,右から $i$ 個取り出したときの種類数を表す列 $R = ( R_0, R_1, \dots, R_n )$ も構築できます.左から $i$ 個取り出すとき,右から取り出す個数は自動的に $n - i$ になるので,各 $i$ について $L_i + R_{ n - i }$ を求めて最小値をとればそれが答えです.添字の和が $n$ になるように取り出す部分は,$R$ を逆順にして zipWith (+) すれば簡潔です.
 さて,各 $i$ について左から $i$ 個取り出したときの種類数を $i$ 番目($0$-indexed)の要素にもつリストを構築したいわけですが,種類数を求める方法として Data.Set を用いる方法があります.Set.empty を初期値として scanl で畳み込めば,各 $i$ に対して左から $i$ 個の要素から構築した Data.Set からなるリストができます.あとは Set.sizemap してあげれば,欲しかった列ができます.

import qualified Data.Set as Set

main = getLine >> readInts >>= print . maximum . uncurry ( zipWith (+) ) . ( solve &&& reverse . solve . reverse )

solve = map Set.size . scanl ( flip Set.insert ) Set.empty 

 ただ,Data.Set を使う方法だと計算量は $O( n \log n )$ 時間となってやや遅いです.ミュータブルな配列を使って値ごとの出現数を管理しつつ,$0$ から $1$ になるときに種類数を加算するようなアルゴリズムであれば $\Theta( n )$ 時間で実行できますが,実装はやや面倒な感じがします.

main = getLine >> readInts >>= print . maximum . uncurry ( zipWith (+)  ) . ( solve &&& reverse . solve . reverse )

solve as = runST $ do
	counts <- newArray ( 0, n ) 0 :: ST s ( STUArray s Int Int )
	kinds <- newSTRef 0
	res <- newSTRef [0]
	forM_ ( zip [ 1 .. ] as ) $ \( i, a ) -> do
		c <- readArray counts a
		modifyArray counts a succ
		when ( c == 0 ) $ -- do
			modifySTRef kinds succ
		modifySTRef res =<< (:) <$> readSTRef kinds
	reverse <$> readSTRef res
	where
	n = length as

D

 問題文 : https://atcoder.jp/contests/abc397/tasks/abc397_d
 詳細は別記事としますが,$d = x - y$ と置いて式をがちゃがちゃすることで $y$ についての $2$ 次方程式にして,各 $d \in \{ 1, 2, \dots, 10^6 \}$ について解きます.そのままだと $d^4$ の項があって 64 ビット整数でもオーバーフローしてしまいますが,Haskell には Integer 型があって多倍長整数を気軽に使えるので横着できます.

main = do
	n <- readInteger
	printList $ fromMaybe [-1] $ listToMaybe $ do
		d <- [ 1 .. 1000000 ]
		let
			a = 3 * d
			b = 3 * d^2
			c = d^3 - n
		guard $ 0 <= b^2 - 4 * a * c
		let
			rd = round $ sqrt $ fromIntegral $ b^2 - 4 * a * c
			y = ( -b + rd ) `div` ( 2 * a )
			x = y + d
		guard $ 0 < y && x^3 - y^3 == n
		return $ [ x, y ]

E

 問題文 : https://atcoder.jp/contests/abc397/tasks/abc397_e
 まずグラフをいい感じのデータ構造にしながら受け取りたいですが,Array Int [Int] で隣接リストを表現すると扱いやすい気がします.配列の構築には accumArray が使えて,[] を初期値として flip (:) で足し込みます.accumArray に渡す配列は,入力の(片向きの)辺リスト部分を replicate ( n * k - 1 ) readIntsreadIntsmap ( fst . fromJust . B.readInt ) . B.words <$> B.getLine(テンプレ))で受け取って \[ u, v ] -> [ ( u, v ), ( v, u ) ]concatMap すると双方向化できます.
 解法の詳細は別記事としますが,木を適当に根付き木にして,各部分木の根 $r$ をいい感じにパスに含められるかをボトムアップに計算します.
 具体的には,

  • $r$ のところで不適
  • $r$ 以下で分解が完結する
  • 根方向に何らかの長さのパスが伸びる

の $3$ 通りで場合分けします.判定には子がどうなっているかを見て,長さ $k$ 未満のパスが何本伸びてきているかとその長さで場合分けします.この処理は,DFS で実装できます.
 DFS の実装では(Haskell に限らない)典型として根方向に逆走しないように直前の頂点を引数に含めると実装しやすいです.直前の頂点が存在しない(i.e., 訪問中の頂点が根である)場合があるので -1 などの頂点番号として不適な値を番兵にして区別します.Maybe にして区別することもできますが,値を読むコードの煩雑化の度合いに対してメリットが少ないような気もします.
 部分木の根の状態を表す方法として別記事の C++ 実装では不適を -1,部分木内で分割可能を 0,根方向にパスが伸びるときはその長さとしていましたが,意味的に異なる値をすべて整数で扱っているのはやや気持ち悪くもあります.不適な根は一つでも存在するとだめなので,Nothing で表現することにしてみます.Maybe のリストを sequence すると,一つでも Nothing があったら Nothing になり,そうでなければ Just の中身が入ったリストが中身な Just 値になる(型で言うと sequence :: [ Maybe a ] -> Maybe [a])ので,「一つでもあったらだめ」というコンセプトを表現できます.これをリストモナドの do の中で <- すると見かけ上は場合分け無しに異常値を伝播できます.
 また,0 とそれ以外については 0 の代わりに Right () を使い,長さ $s$ を根方向に伝えるのは Left s とすると根方向に伸びるパスの有無を型で区別できて,集計も lefts でできます.
 呼び出し側からは Maybe [ Either Int () ] から Bool を取り出す必要があります.既定値,a -> b な関数,Maybe aを受け取って,Maybe aNothing なら既定値を,そうでなければ中身に関数を適用した値を返す関数 maybe があって.maybe False ( == Right () ) とすることで Just ( Right () ) かどうかを判定する関数を作れます.似たような関数で fromMaybe がありますが,こちらでどうにかしようとすると fromMaybe ( Left 0 ) となって Left 0 という意味が定まっていない値を使うことになるので気持ちが悪いです.
 ということで,色々やることで値の意味を型で(わたし的に)パーフェクションに分岐できて気持ちよくなれたのですが,ここまでやるとかえって複雑かもしれません……?

main = do
	[ n, k ] <- readInts
	g <- accumArray ( flip (:) ) [] ( 1, n * k ) . concatMap ( \[ u, v ] -> [ ( u, v ), ( v, u ) ] ) <$> replicateM ( n * k - 1 ) readInts
	putStrLn $ yesno $ maybe False ( == Right () ) $ dfs g k 1 (-1)

dfs g k u p = do
	ch <- sequence $ do
		v <- g ! u
		guard $ v /= p
		return $ dfs g k v u 
	let
		( s, sz ) = ( sum &&& length ) $ lefts ch
	case sz of
		0 -> Just $ if k == 1 then Right () else Left 1
		1 -> Just $ if s == k - 1 then Right () else Left $ s + 1
		2 -> if s == k - 1 then Just $ Right () else Nothing
		_ -> Nothing



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

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