ABC345 A～F をHaskellで

ゾロ目とかの回は遊びが入るものだと思ったけど、345はスルーだった。

# A - Leftrightarrow

[問題 ABC345A](https://atcoder.jp/contests/abc345/tasks/abc345_a)

シグネチャを決める。

```haskell
abc345a :: String -- S
        -> Bool   -- 答え
abc345a s = head s == '<' && dropWhile ('=' ==) (tail s) == ">"
```

# B - Integer Division Returns

[問題 ABC345B](https://atcoder.jp/contests/abc345/tasks/abc345_b)

シグネチャを決める。

```haskell
abc345b :: Int  -- X
        -> Int  -- 答え
```

公式解説にあるように、整数除算がどちらに丸めるかは流儀があって、[pedia-剰余演算-実際のプログラミング言語の挙動](https://ja.wikipedia.org/wiki/%E5%89%B0%E4%BD%99%E6%BC%94%E7%AE%97#%E5%AE%9F%E9%9A%9B%E3%81%AE%E3%83%97%E3%83%AD%E3%82%B0%E3%83%A9%E3%83%9F%E3%83%B3%E3%82%B0%E8%A8%80%E8%AA%9E%E3%81%AE%E6%8C%99%E5%8B%95)と、pedia-除法-参考文献にある[Division and Modulus for Computer Scientists](https://www.microsoft.com/en-us/research/publication/division-and-modulus-for-computer-scientists/)に色々書いてある。

Haskellは `div`-`mod` ペアと `quot`-`rem` ペアでどちらの流儀にも対応できる。

## 結果

公式解説では、除数-1を足してから割る云々で、除算をした結果がそのまま答えになるようにしようと頑張っているが、余りも見れば難しく考えなくてもいい。

`mod`は除数（ここでは+10）と同じ符号になるということは、商については切り捨て丸めをするということなので、剰余が出たら切り上げればよい。

```haskell
abc345b x =
  case divMod x 10 of
    (q, 0) -> q        -- 割り切れたらそのまま
    (q, _) -> succ q   -- 余りが出たら1増やす
```

# C - One Time Swap

[問題 ABC345C](https://atcoder.jp/contests/abc345/tasks/abc345_c)

シグネチャを決める。

```haskell
abc345c :: String  -- S
        -> Int     -- 答え
```

## 数えない場合を引く方法

Qiitaの数式モードの都合（アンダースコアが続くと変になる）で、高校数学の$\_n C_k$を$C(n,k)$と書く。

任意の2カ所 $1 \leq i < j \leq N$ を選ぶやり方は $C(N,2)$ 通りある。
ここで、$i$文字めと$j$文字めが異なる文字ならば、元の$S$とも、他の$(i,j)$の選択とも異なる結果を得る。
そうでなく、$i$文字めと$j$文字めが同じ文字になってしまった場合、$S$のままになるので、そのような場合を数えるとそれは、アルファベット各文字$c$の個数を$K_c$としたとき $\sum_c C(K_c,2)$ である。これを全体から引けばよい。
ただし、そのような場合が一つでもある場合、$S$がそのまま、という場合を数えて1足す必要がある。

```haskell
import Data.Array

abc345c :: String -> Int
abc345c s = nC2 (sum cs) - sum (map nC2 cs) + if any (1 <) cs then 1 else 0
  where
    cs = elems $ accumArray (+) 0 ('a','z') [(c,1) | c <- s]
    nC2 n = div (n * pred n) 2
```

## 数える場合だけを数える方法

$i$ 文字めが $c$ で、$j$ 文字めが $c$ と異なる文字のとき、結果は$S$と異なる文字列になる。
文字 $c$ になる $i$ の場合は $K_c$ とおり、文字 $c$ に**ならない** $j$ の場合は $N - K_c$ とおり、とやると、$i > j$ の場合も含めて倍数えてしまうので、後で2で割る。
また、$S$がそのまま出てくる場合の補正も、上と同様にする。

```haskell
abc345c s = div (sum [c * (n - c) | c <- cs]) 2 + if any (1 <) cs then 1 else 0
  where
    cs = elems $ accumArray (+) 0 ('a','z') [(c,1) | c <- s]
    n = sum cs
```

## 公式解説、ユーザ解説の方法

$(N^2 - \sum_c K_c^2)/2$ (補正の1を除く) となるらしい。

```haskell
abc345c s = div (n * n - sum (map (^ 2) cs)) 2 + if any (1 <) cs then 1 else 0
  where
    cs = elems $ accumArray (+) 0 ('a','z') [(c,1) | c <- s]
    n = sum cs
```

# D - Tiling

[問題 ABC345D](https://atcoder.jp/contests/abc345/tasks/abc345_d)

シグネチャを決める。色々横着する。

```haskell
abc345d :: [Int]    -- N,H,W
        -> [[Int]]  -- Ai, Bi
        -> Bool     -- 答え
```

マス目の並びを、上の行から順に埋めていくことを考える。
次に置くタイルは、まだ残っている最も上の行で、最も左の角に合わせて配置する。
すると、置き場所は一意に定まる。
どのタイルを置くかが、たかだか$N \leq 7$とおり、タテかヨコかで2通りなので、
$7 \cdot 2 \cdot (6 \cdot 2 \cdot ( \dots (1 \cdot 2) \dots ) = 7! \cdot 2^7 = 645,120$ 通りは、そのままやればよい。

マス目の状態を表すやり方として、`Array (Int,Int) Bool` とか持ち出さなくても、「それぞれの列ごとに、下から何マス空いているか」の一次元配列 `Array Int Int` だけで十分である。

## 結果

```haskell
import Data.Array

abc345d :: [Int] -> [[Int]] -> Bool
abc345d [n,h,w] abs = recur arr0 abs
  where
    arr0 = listArray (1,h) $ replicate h w
    recur arr abs
      | p == 0    = True
      | otherwise = or
        [ recur arr1 (delete ab abs)    -- 5.再帰的に探索
        | ab@(a:b:_) <- abs         -- 1.タイルを選ぶ
        , (x,y) <- [(a,b),(b,a)]    -- 2.タテまたはヨコに
        , x <= p, y <= r            -- 3.置けるなら
        , let arr1 = arr // [(i, p - x) | i <- [q .. q + pred y]] ] -- 4.盤面を更新して
      where
        (p,q,r) = findmax arr

-- 最大値、開始位置、続く個数、を取り出す
findmax :: Array Int Int -> (Int,Int,Int)
findmax arr = foldr step (0,0,0) $ assocs arr
  where
    step (i,h) (a,b,c)
      | a == h, succ i == b = (a, i, succ c) -- 延長
      | a <= h              = (h, i, 1)      -- 記録更新またはより左
      | otherwise           = (a, b, c)      -- 変更なし
```

# E - Colorful Subsequence

[問題 ABC345E](https://atcoder.jp/contests/abc345/tasks/abc345_e)

シグネチャを決める。$C_i, V_i$ は横着する。

```haskell
abc345e :: Int      -- N
        -> Int      -- K
        -> [[Int]]  -- Ci, Vi
        -> Int      -- 答え
```

## 考える

### 素朴なDP

単純なDPを考えると、左から順に調べていき、$i$個めまで見た $score_i[k,c]$を
- ボールを除いた個数（$0 \leq k \leq K$）
- 列の末尾のボールの色（$0 \leq c \leq 10^5$) （0は、前がないことを表す）

ごとの価値の合計の最大値として、全体を走査してこれを更新したら、$\max_c score_N[K,c]$ が答えとなりそうに思える。しかしこの配列を更新するには、$j = i+1$ 個めのボールを

- 無視する場合に対応して $score_j[k,c]$ の候補に $score_i[k-1,c]$ がある
- 選ぶ場合に対応して $score_j[k,C_j]$ の候補に $V_j + score_i[k,c] \ (c \neq C_j)$ がある

中から、最大値を選ぶことになる。つまり
$score_j[k,C_j] = \max(score_i[k-1,C_j], V_i + \max_{c \neq C_i} score_i[k,c])$
$score_j[k,c \neq C_j] = score_i[k-1,c]$
となる。添え字$k$について+1ずらし、添え字$C_j$の要素のみ、それ以外の全ての色の値の最大値を探す、という集めるDPになる。
しかし、最大値を求める回数が多すぎてこれでは間に合わない。

### スコアで色を順序づけ

$score_i[k,c] = W_{ikc}$を純粋な二次元配列で持つ代わりに、$W_{ikc}$の値の大きい順に、それがどの色のスコアかを添えた優先度付きキューで、$score_i[k] = [ (W_a, C_a), \dots ]$ という形で持つことを考える。
すると、上のステップ更新は、$score_i[k-1] \ni (W_j, C_j)$, $score_i[k]$ の $C_j$ でない最大値を $(W_x, C_x)$ として、
$score_j[k] =$ $score_i[k-1]$ のキューの $(W_j,C_j)$ を $(\max(W_j, V_j + W_x), C_j)$ に置き換えたもの
とすることになり、また、最終結果は $score_N[K]$ の先頭の値となる。
しかし、色の種類分の長さのキューを全部なぞって$(W_j, C_j)$を探し出す計算は重そうだ。

### 富士山と北岳

さらにここで、キューは全ての色について持っておく必要はなく、最大スコアとその色、二番手のスコア（同着あり）とその色、の先頭二つだけを持っていれば済む。
$score_i[k] = [(W_a,C_a), (W_b,C_b), \dots]$ とする。$C_a \neq C_b$ である。
「$score_i[k]$の$C_j$でない最大値$(W_x,C_x)$」を見つけるには、$C_j \neq C_a$ ならば $W_a$, さもなくば（つまり$C_a = C_j$ つまり $C_b \neq C_j$ なので）$W_b$ を選べばよい。

もう一つの操作として $(W_j, C_j)$を探し出す必要があるように見えるが、続きの置き換えまで合わせて読むと「$(W_j, C_j)$も含む$score_i[k-1]$のキューに、$W_j < V_j + W_x$ ならば $(V_j+W_x, C_j)$を挿入する。」そしてその先頭2要素だけに注目すると、
$score_i[k-1] = [(W_p,C_p),(W_q,C_q),\dots]$ から、

- $C_p = C_j$ のとき、$[(\max(W_p, V_j+W_x), C_j),(W_q,C_q)]$ に置き換え
- $C_q = C_j$ のとき、$[(W_p, C_p),(\max(W_q, V_j+W_x,), C_j)]$ を降順にソート
- どちらでもないとき、$[(W_p, C_p),(W_q,C_q),(V_j+W_x, C_j)]$ を降順にソートし3位は退場

で$score_j[k]$ は作れるとわかる。つまり、$W_j$が上位2名に入っていなければ考慮する必要はなく、入っていたときに3位以下の情報が必要になったりもしない。

## 結果

上位2名を連れていこうとして1人しかいないとか、誰もいないような場合にも対応させるプログラミングをして、

キュー代数的データ型
```haskell
data TOP2 = E0                      -- 空
          | E1 (Int,Int)            -- ぼっち
          | E2 (Int,Int) (Int,Int)  -- 2名在籍
```
で表現し、細かく計算を `seq` で促したら
[4292ms, 63MB](https://atcoder.jp/contests/abc345/submissions/51384941) でギリACした。

4項組で

- $(-1,0,-1,0)$ : 空
- $(w,c,-1,0)$ : ぼっち
- $(w_1,c_1,w_2,c_2)$ : 2名在籍
 
として、これを Unboxed Vector に入れたら
[1022ms, 67MB](https://atcoder.jp/contests/abc345/submissions/51388776) で堂々ACした。

# F - Many Lamps

[問題 ABC345F](https://atcoder.jp/contests/abc345/tasks/abc345_f)

シグネチャを決める。色々横着する。

```haskell
abc345e :: [Int]       -- N,M,K
        -> [[Int]]     -- ui, vi
        -> Maybe [Int] -- 答え
```

## 全域森

わからなくて[フレンズさんのヒント](https://twitter.com/kyopro_friends/status/1769002549691265478)を見た。

Union-Findをとって全域木を作ろうとして全部連結にならなくても気にしなくてよくて、全域森の辺の本数が1になった葉uについて、そこから出る辺をeとして、

- ランプが点いているときは、uとeはもう使わない。
- ランプが消えているならeを使って点灯させて、反対側の頂点vのランプも反転させる。使い終わった辺eは森から取り除いて、それによってvが持つ辺が減る。ここでvは葉になることがある。
このときvが消えたなら、点灯しているランプの個数は変化しない。点いたなら、2個増える。

を繰り返して、Kまでつけられれば勝ち。
なお、ランプは偶数個しかつけられないので、奇数を指定されたら即アウトにできる。

## 公式解説のやり方

全域森を作るのに、深さ優先探索でグラフを貪欲に走査し、またこの探索における再帰の戻りとは葉から根に向かう向きなので、このときにその辺を消費する計算も同時に行う、[とてもコンパクトなコードが公式解説に掲載されている](https://atcoder.jp/contests/abc345/editorial/9558)。

のだけど、23行めから33行めで、無名関数を作って`dfs`に入れて、それが再帰的に自分を呼び出せるように第1引数に入れて34行めで`dfs(dfs,i)`として呼び出す、というC++独特の書き方を避けて、もっとprimitiveなpseudo codeに近い書き方で解説は書いてほしい。

多分、実行時に要素を確保する`vector`を`main()`の中で作って、それを`dfs`から大域的にアクセスしようとすると、こうやるのが楽だからなんだろうけども。

このアプローチをHaskellに翻案した。

```haskell
import qualified Data.Vector.Unboxed.Mutable as MUV
import Control.Monad.ST
import Data.Array

abc345f :: Int -> Int -> Int -> [[Int]] -> Maybe [Int]
abc345f _ _  0 _ = Just []          -- 0は即座に成功
abc345f _ _  k _ | odd k = Nothing  -- 奇数は即座に失敗
abc345f n _m k uvs = runST $
  do
    vis  <- MUV.replicate n1 False -- ノードが調査済みかのフラグ
    lamp <- MUV.replicate n1 False -- ノードのランプが点灯中かのフラグ
    (rest, ans) <- foldM (\ra c -> snd <$> dfs vis lamp ra c) (k, []) [1..n]
    return $ if rest == 0 then Just ans else Nothing
  where
    n1 = succ n
    g = accumArray (flip (:)) [] (1,n) [p | (i, u:v:_) <- zip [1..] uvs, p <- [(u,(v,i)),(v,(u,i))]] -- 頂点に接続する辺の番号リスト G
    dfs :: STArray s Int Bool -- vis
        -> STArray s Int Bool -- lamp
        -> ( Int              -- rest ランプ残り
           , [Int])           -- acc 使った辺リスト
        -> Int                -- c 訪問する頂点
        -> ( Bool             -- c は初訪問だった
           , (Int,[Int]))     -- (rest,acc)の更新値
    dfs _is _amp ra@(0,_) _ = return (False, ra) -- 目標達成済みなら何もしない
    dfs vis lamp ra c = do    -- 頂点cからのDFSを試みる
      vc <- MUV.read vis c
      if vc then return (False, ra) else do -- 既に訪問済みなら失敗で直帰
        MUV.write vis c True       -- cに訪問済みの印を付ける
        ra3 <- foldM (\ra1 (d, i) -> do  -- cから辺iで接続されるdについてdfsを広げる
          (vd, ra2@(rest2, acc2)) <- dfs vis lamp ra1 d  -- dへ行って戻る
          if not vd || rest2 == 0 then return ra2 else do   -- d訪問が失敗もしくは目標達成済みならこれ以上何もしない
            ld <- MUV.read lamp d
            if ld then return ra2 else do       -- dが点灯しているなら何もしない
              MUV.write lamp d True             -- 消えているなら点ける 辺iを使う
              lc <- not <$> MUV.read lamp c     -- cも反転させる
              MUV.write lamp c lc
              return $ if lc then (rest2 - 2, i : acc2) else (rest2, i : acc2) -- cが点いたなら2減らす
          ) ra (g ! c)
        return (True, ra3)
```

C++で`dfs`をくくりだすと

```c++
void dfs(int c) {
    vis[c] = true;
    for (auto& [d, id] : G[c]) {
        if (vis[d]) continue;
        dfs(d);
        if (rest <= 0) return;
        if (lamp[d]) continue;
        lamp[d] = true;
        lamp[c] = ! lamp[c];
        if (lamp[c]) { rest -= 2; }
        ans.push_back(id);
    }
}
```

これで済むので、（[全容はこちら](https://atcoder.jp/contests/abc345/submissions/51484016)）なんとも。

`vis`, `lamp` と大域変数 `rest`, `acc` を引数で取り回さず、RWSモナドとレンズでキレイに隠して ST モナドに重ねて書く、とか出来れば、もうすこし見た目が何とかなるのかしら。

（ずっとREに悩まされた原因が、辺データを$M$個読むべきところ$N$個読んでいた、という読み込み部の凡ミスだった。道理で本体をどれだけ読んでもおかしいところはない訳だよ！）

# G - Sugoroku 5

[フレンズさんいわく](https://twitter.com/kyopro_friends/status/1769003092698419651)
> アライグマ「G問題はFPS講座なのだ……」

公式解説もユーザ解説もやばみが溢れているので、こんな危険な場所からは早く逃げた方がいい。