はじめに
実装メイン．テンプレは別記事．
A
問題文 : https://atcoder.jp/contests/abc446/tasks/abc446_a
入力文字列に対する加工は全文字を小文字にすることと同じです．そして Data.List.Extra には [String] の中身を全て小文字に変換する関数 lower があるので，( "Of" ++ ) . lower すれば出力するべき文字列になります．
main = getLine >>= putStrLn . ( "Of" ++ ) . lower
B
問題文 : https://atcoder.jp/contests/abc446/tasks/abc446_b
まず入力の受け取りの時点で考える余地があります．$2$ 行一組で $L_i, X_i$ が入力されてきますが，$n$ 回の IO アクションを繰り返すのには replicateM をよく使います．典型的にはスニペット化した readInts = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine を渡したりしますが，今回は $L_i$ の方は不要で $X_i$ だけを読めば十分なので渡すアクションを工夫します．一行を読み飛ばしてから次の行を [Int] として読んでそれを返すアクションは do 記法で
do
getLine
readInts
と書ける*1ので，これで実装できます．これでもよいのですが，$2$ つのアクションを $1$ つ目の結果を無視するように合成する関数 (>>) があるので，getLine >> readInts と実装できてこちらの方がスッキリしそうです．
解法ですが，既に選ばれている飲料の番号を何らかのデータ構造 $S$ で管理することにすると，各 $X_i$ に対して $S$ に含まれない要素を線形探索して，見つかればそれを出力するべき値としつつ $S$ に加え，そうでなければ $0$ を出力するべき値としつつ $S$ は変化させずに次に行くということをします．$S$ の実体としては Data.IntSet が便利で，線形探索は Data.IntSet.find が提供されています．これは，見つかればそれを Just に包んだものを，見つからなければ Nothing を返します．見つからなかった場合の出力は $0$ なので，fromMaybe 0 に通すと出力すべき値が得られます．$S$ の更新については，$S$ に $0$ も挿入してしまっても線形探索の結果に影響しないので，$0$ かどうかに拘らず fromMaybe の結果を挿入してしまってよいです．ということで，$S$ で状態を管理し，次の $X_i$ が来たときの更新後の $S$ と書き出す値の計算方法が分かったので，mapAccumL で畳み込むことができます．
main = do [ n, m ] <- readInts xss <- replicateM n ( getLine >> readInts ) mapM_ print $ snd $ mapAccumL solve ISet.empty xss solve s xs = ( ISet.insert res s, res ) where res = fromMaybe 0 $ find ( flip ISet.notMember s ) xs
C
問題文 : https://atcoder.jp/contests/abc446/tasks/abc446_c
卵の総数がそう多くないので卵の在庫をキューで管理すれば問題を解ける……んですが，Haskell には標準っぽいところにキューが無いのが悩みどころです．ありがちっぽい Workaround として，Data.Sequence で代用します．
古い卵の廃棄処理のために消費期限をキューに入れることにすると日毎に行われるそれぞれの処理は，
Data.Sequence replicate a ( i + d )を><で右に連結Data.Sequence.drop bするData.Sequence.dropWhileL ( <= i )する
となります．これである日の始業時のキューから終業時のキューを作る方法ができたので，foldl で畳み込むことができます．畳み込むリストの方は日付と $A_i, B_i$ の全部を使うので zip3 [ 1 .. ] as bs を渡します．
main = readInt >>= flip replicateM do [ n, d ] <- readInts as <- readInts bs <- readInts print $ Seq.length $ foldl ( solve d ) Seq.empty $ zip3 [ 1 .. ] as bs solve d seq ( i, a, b ) = Seq.dropWhileL ( <= i ) $ Seq.drop b $ seq >< Seq.replicate a ( i + d )
D
問題文 : https://atcoder.jp/contests/abc446/tasks/abc446_d
次のように状態をとる DP を考えます：
\[
\mathit{dp}[a] = \text{$a$ を末尾とする上昇列の長さの最大値}
\]
すべての $a$ について $dp[a] = 0$ と初期化してから
\[
\mathit{dp}[ A_i ] \overset{ \mathord{ \max } }{ \leftarrow } \mathit{dp}[ A_i - 1 ] + 1
\]
という更新*2を $i$ の昇順に行えば各 $\mathit{dp}[ A_i ]$ が正しく求まります．しかしこの DP テーブル全体をもつと MLE する（筈な）ので，$A$ に含まれる添え字についてのみ陽にもつことにして配列ではなく Data.IntMap の形でもつことで AC できます．
ということで更新時の $\mathit{dp}[ A_i - 1 ] + 1$ の計算は，Data.IntMap.lookup が
- キーが存在すればキーに対応する値を
Justに入れたもの - キーが存在しないなら
Nothing
を返すことを踏まえて
Data.IntMap.lookup ( a - 1 )するfromMaybe 0で，Just値が来たらその中身を，Nothingが来たら既定値として $0$ を返すsuccでインクリメント
とすれば求まります．また，Data.IntMap.insertWith f k v で
- キー
kが存在しないなら( k, v )を挿入 - キーが存在するならキーに対応する値を
v'としてf v v'で置き換える
ということをしてくれるので，これを使って更新後の IntMap を作れます．ということで次の $A_i$ を受け取ったときの状態の更新が実装できるので，foldl で畳み込むことができます．
あとは，Data.IntMap.elems で値だけ取り出してから maximum を取れば答えです．
main = do n <- readInt as <- readInts print $ maximum $ IMap.elems $ foldl solve IMap.empty as solve im a = IMap.insertWith max a v im where v = succ $ fromMaybe 0 $ IMap.lookup ( a - 1 ) im
E
問題文 : https://atcoder.jp/contests/abc446/tasks/abc446_e
\[
V = \{ 1, 2, \dots, m - 1 \}^2
\]
とし，
\[
E = \{ ( ( s, s' ), ( ( s', ( bs + as' ) \bmod m) ) \mid ( s, s' ) \in V, s \neq 0, s' \neq 0 \}
\]
とすれば，有向グラフ $( V, E )$ が見えてきます．このグラフにおいて $( \{ 0 \} \times \mathbb Z ) \cup ( \mathbb Z \times \{ 0 \} ) \in V$ に到達できない $V$ の元の個数答えです．これは，メモ化した DFS を（メモを引き継ぎながら）全頂点を始点に実行すれば求まります．
ということで，メモテーブルを Data.IntMap でもてば畳み込むことができます．
やや頂点数が多いので MOD をとる回数が多いと TLE したりするので効率には気を付ける必要があります．IntMap ではなくミュータブル配列で実装すれば余裕ができそうですが，イミュータブルデータ構造で構成した方が綺麗に実装できがちなので，小手先テクでなんとかなるならイミュータブルデータ構造で実装したい気持ちです．順序対 $( s, s' )$ の代わりに整数 $1000s + s'$ をもつことで Data.IntMap 載るようにするなどもしつつ，以下のようになりました．
main = do [ m, a, b ] <- readInts let vs = do x <- [ 0 .. m - 1 ] y <- [ 0 .. m - 1 ] return $ x * 1000 + y g = array @UArray ( 0, 1000^2 ) do x <- [ 0 .. m - 1 ] y <- [ 0 .. m - 1 ] let z = ( a * y + b * x ) `mod` m return $ ( x * 1000 + y, if x == 0 || y == 0 then -1 else y * 1000 + z ) print $ IMap.size $ IMap.filter not $ foldl ( dfs g ) ( IMap.empty ) vs dfs g m u = dfs' m u where dfs' m u | v == -1 = IMap.insert u True m | IMap.member u m = m | otherwise = IMap.insertWith (||) u ( fromJust $ IMap.lookup v m' ) m' where v = g ! u m' = dfs' ( IMap.insert u False m ) v
F
問題文 : https://atcoder.jp/contests/abc446/tasks/abc446_f
頂点 $\{ 1, 2, \dots, k \}$ のみを経由して到達可能な頂点の集合 $S$ と $S$ 中の頂点から $1$ 歩で到達可能かつ $S$ に含まれない頂点の集合 $T$ をもてば答えは計算できますが，◯ぬ程 TLE したのでミュータブルデータ構造に逃げました．
$T$ に求める働きの内 BFS でのキューに相当する部分を Data.IntSet で実現し，対数ファクターをできるだけ削るためキューに含まれているかの判定は別途頂点番号から真偽値へ写す STUArray で管理することにします．また，$S, T$ の要素数も Int を STRef に入れてミュータブルに更新します．
ここまで来るとコードの要相はほぼ手続き型のスタイルになります．「配列から要素を読み出して，その値についての条件によって分岐・ループする」という処理が頻出してきますが，素朴には（Control.Monad の範囲では）if のようなことには一旦 <- で取り出して束縛することになったりして煩雑ですし，while ループ相当のことをする方法は割と謎です．ですが，Control.Monad.Extra まで見ると ifM, whenM, whileM などがあって，liftA 系の関数や fmap = <$> などと組み合わせると真偽値がアクションに包まれているケースや while ループ相当の処理がかなり書きやすくなります．
main = do [ n, m ] <- readInts g <- accumArray @Array ( flip (:) ) [] ( 1, n ) . map mp <$> replicateM m readInts mapM_ print $ solve g solve g = runST do visible <- newArray ( 1, n ) False :: ST s ( STUArray s Int Bool ) writeArray visible 1 True que <- newSTRef $ ISet.singleton 1 cnt <- newSTRef 0 res <- newSTRef 1 forM [ 1 .. n ] $ \s -> do whenM ( readArray visible s ) do modifySTRef res pred whileM do ifM ( liftA2 (||) ( ISet.null <$> readSTRef que ) ( ( s < ) . ISet.findMin <$> readSTRef que ) ) ( return False ) ( do u <- ISet.findMin <$> readSTRef que modifySTRef que ISet.deleteMin modifySTRef cnt succ forM_ ( g ! u ) $ \v -> do whenM ( not <$> readArray visible v ) do writeArray visible v True modifySTRef res $ ( + bool 0 1 ( s < v ) ) modifySTRef que ( ISet.insert v ) return True ) ifM ( ( == s ) <$> readSTRef cnt ) ( readSTRef res ) ( return -1 ) where ( _, n ) = bounds g
