以下の内容はhttps://torus711.hatenablog.com/entry/2025/11/16/202454より取得しました。


Haskell で AtCoder ABC 432, A-C+E

はじめに

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

A

 問題文 : https://atcoder.jp/contests/abc432/tasks/abc432_a
 降順に並べ替えてくっつけたものが答えなので,concat . reverse . sort します.データの流れが直線的で自然に一行になるので,あまり書くことがありません…….

main = readStrs >>= putStrLn . concat . reverse . sort

B

 問題文 : https://atcoder.jp/contests/abc432/tasks/abc432_b
 A と似たような問題ですが,leading zero が禁止されているため 0 だけ特別に処理する必要があります.0 以外の数字の並べ方は昇順にするのが明らかに最適です.更に 0 をどこかに挿入したいですが,できるだけ上位の桁になるように挿入する方が値が小さくなります.
 よって,一旦 0 の個数(zeros とします)を数えてから 0 を取り除き,残りを昇順にソートした文字列の $1$ 文字目の直後に replicate zeros '0' を挿入したもの(実際には headtail に分けて (:), (++) で作る)が答えです.

main = do
	s <- sort <$> getLine
	let
		zeros = countIf ( == '0' ) s
		s' = filter ( /= '0' ) s
	putStrLn $ head s' : replicate zeros '0' ++ tail s'

C

 問題文 : https://atcoder.jp/contests/abc432/tasks/abc432_c
 まず,貰える個数が最も少ないヒトが目一杯重く受け取ったときの重さよりも,貰える個数が最も多いヒトが目一杯軽く受け取ったときの重さが重くなってしまうと不可能だと考察できます.よって,
\[
y \min A < x \max A
\]
のときは不可能です.更に,達成できる重みの上界は $y \min A$ ですが,上記の不等式が満たされていないならば,全てのヒトが重み $y \min A$ 以上貰えます.ただし,これは必要十分条件ではありません(一敗).
 ヒト $i$ が飴を最小重量で貰うと重み $x A_i$ になり,ここで $x A_i \leq y \min A$ です.その状態から大きい飴ひとつを小さい飴ひとつと交換することで貰える重みを $y - x$ だけ増やすことができます.言い換えれば $y - x$ ずつでしか重みを調整できません.従って,
\[
y - x \nmid y \min A - x A_i
\]
のとき($a \mid b$ は $a$ が $b$ を割り切ることを表す記号で,$a \nmid b$ はその否定です)も不可能になります.
 ということで実装ですが,割り切れるときに Just を,そうでないときは Nothing を対応付ける [ Maybe Int ] をリストの do 記法で作ります.このリストに対して sequence をすると [ Maybe Int ] から Maybe [Int] になります.ここで元のリストに Nothing が入っている場合は Nothing となり,そうでなければ Just になります.これに fmap sum をすれば答えが出てきます.
 更に,先述の不等式の判定を do の中に書くと,同じ判定を何度も行ってしまうことと引き換えに -1 というリテラルを書く回数を減らせますが,一長一短という感じがあります.

main = do
	[ n, x, y ] <- readInts
	as <- readInts
	let
		ma = y * minimum as
		mi = x * maximum as
		res = sum <$> sequence do
			a <- as
			return if mi <= ma && ( ma - a * x ) `mod` ( y - x ) == 0
				then Just $ ( ma - a * x ) `div` ( y - x )
				else Nothing
	print $ fromMaybe -1 res

E

 問題文 : https://atcoder.jp/contests/abc432/tasks/abc432_e
 やることは公式解説と大体同じです.ということでセグメント木が欲しいわけですが,最近の言語アップデートAtCoder Library (ACL)Haskell 移植版,ac-library-hs が入ったので早速使ってみます.とはいえ,使い方自体に文量を割くのも本題ではないという感じがしますので,そのあたりは割愛します.
 ところで,公式解説では Array of Structures で実装されていますが,本記事では Structure of Arrays で実装します.というのも,AtCoder.SegTree は載せる型に型クラス制約として Monoid を要求しますが,加算が成すモノイドは Data.MonoidSum が用意されています.なので,タプルにしてモノイド演算を実装するより楽そうです.ということで,$A$ を STUArray で,(公式解説で言うところの)$C_j$ および $C_j j$ を AtCoder.SegTree で管理します.
 データ構造の使い方以外の部分の話をします.クエリの読み込みは replicateM q readInts のようになるのが自然かと思いますが,今回はクエリひとつを受け取って処理する関数 process[ 1, x, y ], [ 2, l, r ] でパターンマッチで場合分けするように書いてみました.クエリの種類によって出力するべき値があったり無かったりするので,結果は Maybe Int で返します.これをクエリリストに mapM すると [ Maybe Int ] が返ってきて,catMaybes によって Just の中身だけを並べたリスト(=出力するべきもの)になります.
 クエリ $1$ についてはあんまり書くことが無くて,データ構造を適当に操作してから return Nothing するだけです.クエリ $2$ については工夫の余地があります.AtCoder.SegTree に $3$ 回 prod をして結果たちの和を返すわけですが,単純にそれぞれ <- で束縛すると結果が Sum に包まれている関係で

res1 <- fmap ( l * ) <$> SegTree.prod segtreeC 0 l
res2 <- SegTree.prod segtreeP l ( r + 1 )
res3 <- fmap ( r * ) <$> SegTree.prod segtreeC ( r + 1 ) ( m + 1 )
return $ Just $ getSum $ res1 <> res2 <> res3

res1 <- ( l * ) . getSum <$> SegTree.prod segtreeC 0 l
res2 <- getSum <$> SegTree.prod segtreeP l ( r + 1 )
res3 <- ( r * ) . getSum <$> SegTree.prod segtreeC ( r + 1 ) ( m + 1 )
return $ Just $ res1 + res2 + res3

になるかと思います.いずれにしても fmapgetSum を何回も書いているのが気になります.res2 を得る部分について,前者は fmap id <$> しているのと同じで後者は fmap id . が左にあると思うと,全ての行は getSum してから何らかの関数を fmap している形に統一できます.そこで,まずアクションのリスト [ SegTree.prod segtreeC 0 l, SegTree.prod segtreeP l ( r + 1 ), SegTree.prod segtreeC ( r + 1 ) ( m + 1 ) ] を作ってから sequence したものに map getSum することにすると,getSum の重複を消せます.次に結果にそれぞれ別の関数を適用したいですが,これは関数のリスト [ ( * l ), id, ( * r ) ]zipWith ($) すると実装できます.あとは和をとって Just で包むだけです.

import qualified AtCoder.SegTree as SegTree
import qualified Data.Vector.Unboxed as V
import Data.Monoid
-- 中略(テンプレ)
m = 5_000_000

main = do
	[ n, q ] <- readInts
	as' <- readInts
	queries <- replicateM q readInts
	let
		cs = elems $ accumArray (+) 0 ( 0, m ) $ zip as' ( repeat 1 )
	mapM_ print $ catMaybes $ runST do
		as <- newListArray ( 1, n ) as' :: ST s ( STUArray s Int Int )
		segtreeC <- SegTree.build @_ @( Sum Int ) ( V.fromList $ map Sum cs )
		segtreeP <- SegTree.build @_ @( Sum Int ) ( V.fromList $ map Sum $ zipWith (*) cs [ 0 .. ] )
		let
			process [ 1, x, y ] = do
				a <- readArray as x
				SegTree.modify segtreeC ( pred <$> ) a
				SegTree.modify segtreeP ( subtract a <$> ) a
				writeArray as x y
				SegTree.modify segtreeC ( succ <$> ) y
				SegTree.modify segtreeP ( (+) y <$> ) y
				return Nothing
			process [ 2, l, r ]
				| l < r = Just . sum . zipWith ($) [ ( * l ), id, ( * r ) ] . map getSum <$> sequence [ SegTree.prod segtreeC 0 l,
						SegTree.prod segtreeP l ( r + 1 ),
						SegTree.prod segtreeC ( r + 1 ) ( m + 1 ) ]
				| otherwise = return $ Just $ l * n
		mapM process queries



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

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