はじめに
テンプレは別記事．
A
問題文 : https://atcoder.jp/contests/abc402/tasks/abc402_a
入力される（英文字からなる）文字列から大文字だけ取り出す問題です．大文字だけ取り出して，それを出力する関数は putStrLn . filter isUpper と書けて，この関数への入力は getLine の結果（というか中身？）そのものなので，（do は使わずに）>>= で繋いでしまえばすっきりします．
main = getLine >>= putStrLn . filter isUpper
B
問題文 : https://atcoder.jp/contests/abc402/tasks/abc402_b
問題文を素直に読むとキューを使ってシミュレートする問題に見えますが，よく考えるとキューから pop される個数はクエリの順序とは無関係にクエリ 2 の個数で，その中身の順序はクエリ 1 だけを取り出した列（から $x$ を取り出して自然に得られる列）に一致します．
入力されるクエリ部分の各行を [Int] として受け取ることにすれば，filter ( ( == 1 ) . head ) して map last することで $x$ だけ取り出すことができて，このリストの長さをクエリ全部の個数から引くことで取り出すべき個数も分かります．
このようにすると，キューを引数で引き回す（あるいは同質なこととして mapAccumL で畳み込む）ようなことをせずに実装できます．
main = do q <- readInt queries <- replicateM q readInts let que = map last $ filter ( ( == 1 ) . head ) queries mapM_ print $ take ( q - length que ) que
C
問題文 : https://atcoder.jp/contests/abc402/tasks/abc402_c
「複雑じゃないか……？」というのはさておき．
料理 $i$ に必要な各材料 $A_{ i, j }$ について，$B_k = A_{ i, j }$ となるような添字 $k$ が一意的に定まります．料理 $i$ を食べられるようになるのはこうして定まる添字たちの最大値が指す日以降の日ですが，これは各 $A_{ i, j }$ に対応する添字を（ある程度高速に）求められれば maximum すれば求められます．ということで $B_i$ に $i$ を対応付ける配列が欲しい気持ちになるわけですが，$B$ に $\langle 1, 2, \dots \rangle$ を zip してできるリストを使って array で（イミュータブル）配列にすればよいです．本質的に欲しいのは各料理毎の初めて食べられるようになる日ですが，さっきの配列を btoi として，$A$ の各行に maximum . map ( btoi ! ) を map すれば求まります．問題に答えるためには日毎に「それ以前に食べられるようになった料理の個数」が必要ですが，「答えとなるリストに対して，初めて食べられるようになる日以降すべてに $1$ を加算する」と思うといもす法になります．Haskell では，端点への加減算をしたリストに対しての scanl や scanl1 で実装できます．
main = do [ n, m ] <- readInts ass <- map tail <$> replicateM m readInts btoi <- uncurry array . ( ( 1, ) . length &&& id ) . flip zip [ 1 .. ] <$> readInts let ls = map ( maximum . map ( btoi ! ) ) ass psums = scanl1 (+) $ elems $ accumArray (+) 0 ( 1, n ) $ zip ls ( repeat 1 ) mapM_ print psums
D
問題文 : https://atcoder.jp/contests/abc402/tasks/abc402_d
$\text{直線が交叉する} \Leftrightarrow \text{傾きが異なる}$ なので，傾きごとに数えることで交叉する個数を求められて，これを直線 $2$ 本をとる組合せの総数から引くことで答えを求められます．
ここでは理屈は書きませんが，各 $( A_i, B_i )$ に $( A_i + B_i ) \bmod n$ を対応付けるとこの値が傾きと $1:1$ 対応します．accumArray (+) 0 すれば値ごとの個数を効率的に数えられて，あとは $k$ 個のものから $2$ 個を選ぶ組合せの総数 $\binom k 2 = \frac { k ( k - 1 ) } 2$ を使って算数すれば答えが求まります．
main = do [ n, m ] <- readInts ss <- map ( ( `mod` n ) . sum . map pred ) <$> replicateM m readInts print $ comb m - ( sum $ map comb $ elems $ accumArray (+) 0 ( 0, n - 1 ) $ zip ss $ repeat 1 ) comb n = n * ( n - 1 ) `div` 2
E
問題文 : https://atcoder.jp/contests/abc402/tasks/abc402_e
ここでは各 $P_i$ は入力で与えられるものを $100$ で割った値とします．
関数 $f$ を
\[
f( S, x ) = \text{AC 済みの問題の集合が $S$ で所持金が $x$ の状態から最適に行動した場合の得点の期待値}
\]
とします．次に取り組む問題は未 AC の問題から自由に選べて，問題 $i$ に取り組んだときに起こることは
- 確率 $P_i$ で AC する．$S_i$ 点を獲得した上で，AC 済みの問題は $S \cup \{ i \}$ に変化し所持金が $C_i$ 減る．
- 確率 $1 - P_i$ で AC しない．総得点と AC 済みの問題は変化せず，所持金だけ $x$ 減る．
です．期待値は確率と値の積で求められて（というか定義されて？），期待値が最も大きい行動を自由に選べるので，
\[
f( S, x ) = \max( \{ 0 \} \cup \{ P_i ( S_i + f( S \cup { i }, x - C_i ) + ( 1 - P_i )( f( S, x - C_i ) \mid i \in \{ 1, 2, \dots, n \} \mid i \not \in S, C_i \leq x \} )
\]
となります．あとはこれをメモ化再帰にすることで問題を解けます．
メモ化再帰を実装するにあたってはミュータブル配列が欲しいので，DP テーブルは ST モナドの中で Double を要素とする STUArray を作って使います（本当は未訪問を Nothing で表現するために Maybe Double を要素とする STArray にしたいのですが，TLE しました．つらい……）．上述の関数の引数に DP テーブルを加えて，適当な初期値（e.g. -1）でなければ記録された値を返し，そうでなければ真面目に計算して結果を記録するようにします．
どう実装するときれいかまだ分かりかねているところではあるのですが，遷移先を forM で回すと期待値のリストが入ったアクションが手に入るので，foldl max 0 <$> するのが（今のところ）良さそうに感じています．
main = do [ n, x ] <- readInts [ ss, cs, ps ] <- transpose <$> replicateM n readInts let la = listArray ( 1, n ) ss' = la ss cs' = la cs ps' = la $ map ( ( / 100 ) . fromIntegral ) ps printf "%.12f\n" $ solve x ss' cs' ps' solve x ss cs ps = runST $ do dp <- newArray ( ( 0, 0 ), ( 2^n - 1, x ) ) -1 :: ST s ( STUArray s ( Int, Int ) Double ) dfs dp 0 x where n = length $ ss dfs dp s x = do cache <- readArray dp ( s, x ) if cache /= -1 then return $ cache else do let nx i = x - cs ! ( i + 1 ) cond i = ( not $ testBit s i ) && 0 <= nx i res <- foldl max 0 <$> ( forM ( filter cond [ 0 .. n - 1 ] ) $ \i -> do let p = ps ! ( i + 1 ) res1 <- dfs dp ( setBit s i ) ( nx i ) res2 <- dfs dp s ( nx i ) return $ p * ( fromIntegral ( ss ! ( i + 1 ) ) + res1 ) + ( 1 - p ) * res2 ) writeArray dp ( s, x ) res return res
