ABC325 A～GをHaskellで

Beginnersの名に立ち返った範囲で好印象な回でした。

- C Union-Findなど
- D 貪欲法、キュー
- E ダイクストラ法
- F DP（何DPだろう…）
- G 区間DP

----

# A - Takahashi san

[問題 ABC325A](https://atcoder.jp/contests/abc325/tasks/abc325_a)

`words` で空白で区切り、先頭要素が名字で、これにサンを付けて出力すればよい。

```haskell
main = getLine >>= putStrLn . (++ " san") . head . words

main = getLine >>= putStrLn . foldr (\c ys -> if c == ' ' then " san" else c : ys) ""
```

レンズを使って名を `san` に置き換える、なんてやり方もあるかもしれない。

# B - World Meeting

[問題 ABC325B](https://atcoder.jp/contests/abc325/tasks/abc325_b)

シグネチャを決める。$W_i, X_i$ は手抜きする。

```haskell
abc325b :: Int     -- N
        -> [[Int]] -- Wi, Xi
        -> Int     -- 答え
```

世界標準時で時刻0時から23時のそれぞれについて、それぞれの地域での現地時刻が就業時間帯なときに、参加可能な人数を足し込み、その最大値をとればよい。

## 結果

```haskell
import Data.Array

abc325b :: Int -> [[Int]] -> Int
abc325b n wxs = maximum $ elems arr
  where
    arr = accumArray (+) 0 (0,23)
      [ (t, w)
      | w:x:_ <- wxs
      , t <- [0..23], let tx = mod (t + x) 24, 9 <= tx, tx < 18
      ]
```

# C - Sensors

[問題 ABC325C](https://atcoder.jp/contests/abc325/tasks/abc325_c)

シグネチャを決める。$S_i$はランダムアクセスが必要なので `ByteString` で扱う。

```haskell
abc325c :: Int     -- H
        -> Int     -- W
        -> [ByteString] -- Si
        -> Int     -- 答え
```

[Union-Findを使ってもできる。](https://atcoder.jp/contests/abc325/submissions/46843711)

`PAINT`文の要領で、8近傍で隣接する点を全て同じ色で塗り、何色使ったかを数えるアプローチをとる。
点の座標を `Set (Int,Int)` で扱うと重いので、`Data.Ix.index` を用いて整数に写して `IntSet` で扱う。

## 結果

```haskell
import qualified Data.ByteString.Char8 as BS
import Data.List

import qualified Data.IntSet as IS
import Data.Array

abc325c :: Int -> Int -> [BS.ByteString] -> Int
abc325c h w sss = ans
  where
-- Siを配列化
    sA = listArray (0, pred h) sss
-- 座標の範囲
    bnds = ((0,0),(pred h, pred w))
-- 座標を一次元の添え字に写す
    toIdx = index bnds
-- 座標に '#' があるか
    isDot i j = inRange bnds (i,j) && BS.index (sA ! i) j == '#'
-- '#' のある全ての座標から開始して、塗りつぶす
    (_,ans) = foldl step (IS.empty, 0) [ij | ij@(i,j) <- range bnds, isDot i j]
-- 一つの座標について、初見なら塗りつぶし、カウントを増やす
    step (is, cnt) ij
      | IS.member (toIdx ij) is = (is, cnt)
      | otherwise = (loop is [ij], succ cnt)
-- DFSでPAINTを実行
    loop is [] = is
    loop is (ij@(i,j):ijs)
      | IS.member ix is = loop is ijs
      | otherwise = loop (IS.insert ix is) (ijs1 ++ ijs)
      where
        ix = toIdx ij
-- 隣接する '#' の座標
        ijs1 = [(p,q) | p <- [pred i..succ i], q <- [pred j..succ j], p /= i || q /= j, isDot p q]
```

# D - Printing Machine

[問題 ABC325D](https://atcoder.jp/contests/abc325/tasks/abc325_d)

シグネチャを決める。$T_i, D_i$は手抜きする。

```haskell
abc325d :: Int     -- N
        -> [[Int]] -- Ti, Di
        -> Int     -- 答え
```

それぞれの時刻に到着するものごとに商品を分別する。
このとき、時間切れになる時刻で商品を表現する。
時刻0から始め、現在、印字可能な商品を、時間切れになる時刻順にキューに貯めて消費していく貪欲法を行う。

- キューが空なら、次の商品が入ってくる時刻まで現在時刻を進め、キューを満たす。
  ただし、次がない（番兵が来た）場合は、終了する。
- キューの先頭が時間切れなら、印字せず見送る。
- 現在時刻が、次の商品が到着する時刻になっていたら、キューにそれも混ぜる。
- いずれでもないなら、キューの先頭を消費し、時刻を1進める。

## 結果

キューが空の場合、次の入荷を処理しない場合、を統一的に扱うため、あえてパターンマッチで分解せず、局所束縛で取り出し、遅延評価により値が存在する場合に限って取り出すこのスタイルは、lintには嫌われる。

```haskell
import qualified Data.IntMap as IM
import qualified Data.Heap as H

abc325d :: Int -> [[Int]] -> Int
abc325d n tds = length $ loop 0 H.empty sdss
  where
    sdss = IM.assocs $ IM.fromListWith (++) $ (maxBound, []) : [(t, [t + d]) | t:d:_ <- tds]
    -- t 現在時刻 q 印字可能域にあるものの終了時刻順キュー sdss 次に印字範囲に入るものたち
    loop t q sdss
      | H.null q, s == maxBound = [] -- 全て終了
      | H.null q  = loop s (H.fromList ds) (tail sdss) -- キューが空なら、次の時刻に進める
      | t1 < t    = loop t q1 sdss -- 先頭が賞味期限切れなら、それは捨てる
      | t == s    = loop s (H.union q $ H.fromList ds) (tail sdss) -- t1を消費するより先に、次の群を混ぜる。
      | otherwise = () : loop (succ t) q1 sdss -- 一つ消費して、時刻も1進める
      where
        Just (t1,q1) = H.uncons q
        (s,ds) = head sdss
```

# E - Our clients, please wait a moment

[問題 ABC325E](https://atcoder.jp/contests/abc325/tasks/abc325_e)

…キーエンスの社用車って、首都高速で暴走しているという噂のアレ？

シグネチャを決める。

```haskell
abc325e :: Int     -- N
        -> Int     -- A
        -> Int     -- B
        -> Int     -- C
        -> [[Int]] -- Dij
        -> Int     -- 答え
```

完全グラフになっているので、有向グラフとして距離を数える問題になる。
[フレンズさんの解説](https://twitter.com/kyopro_friends/status/1715728422490816933)にもあるとおり、

- 1から社用車で各都市までの最短時間を求める。$X_i$とする。
- グラフを逆向きに張り、Nから電車で各都市までの最短時間を求める。$Y_i$とする。
- $X_i + Y_i$ の最小値が答えで、それを与える$i$が乗り換えをする都市。

というやり方と、

- ノード$1$～$N$に、社用車で各都市間の道路をグラフに張る。
- ノード$N+1$～$2N$に、電車で各都市間の線路をグラフに張る。
- ノード$1 \leq i \leq N$から$i+N$へ、乗り換えの時間0の辺を張る。
- ノード$1$から$2N$までの距離を求める。

というやり方のどちらでもできる。後者を選んだ。

## 結果

ダイクストラ法のアルゴリズムが `IOVector` を使うのでIO汚染されてシグネチャは変わった。
`ST`モナドに閉じ込めて、かつ、mutable vectorを `freeze` しなくて済むようにしようとすると、どうもうまくできない。

```haskell
import Control.Monad
import qualified Data.ByteString.Char8 as BS
import Data.Char
import Data.List

import qualified Data.Heap as H
import qualified Data.Vector.Unboxed.Mutable as MUV
import Data.Array

abc325e :: Int -> Int -> Int -> Int -> [[Int]] -> IO Int
abc325e n a b c dss =
  do
    (dist,_) <- dijkstraV (n + n) graph 0
    MUV.read dist (n + pred n)
  where
    dsA = listArray (0, pred n) dss
    graph i
      | i < n = (i + n, 0) : [(j1, a * dij) | (j1, dij) <- zip [0..] (dsA ! i)]
      | True  = [(j1, b * dij + c) | (j1, dij) <- zip [n..] (dsA ! subtract n i)]

-- @gotoki_no_joe
dijkstraV :: (Ord w, Num w, Bounded w, MUV.Unbox w)  -- 頂点 Int, 辺の重み w
         => Int                           -- 頂点数
         -> (Int -> [(Int,w)])            -- 隣接頂点とその辺の重み、グラフの情報
         -> Int                           -- 開始点
         -> IO (MUV.IOVector w, MUV.IOVector Int) -- 距離と、最短経路の手前のノード
dijkstraV n graph start = action
  where
    action = do
      dist <- MUV.replicate n maxBound
      MUV.write dist start 0
      prev <- MUV.replicate n (-1)
      let queue = H.singleton (H.Entry 0 start)
      loop dist prev queue
    loop dist prev queue =
      case H.uncons queue of
        Nothing -> return (dist, prev)
        Just (H.Entry cost u, queue1) -> do
          du <- MUV.read dist u
          if du < cost then loop dist prev queue1 else do
            vds <- forM (graph u) (\(v, len) -> do
              let d1 = du + len
              dv <- MUV.read dist v
              if d1 >= dv then return (H.Entry (-1) (-1)) else do
                MUV.write dist v d1
                MUV.write prev v u
                return (H.Entry d1 v)
              )
            let queue2 = H.union queue1 $ H.fromList [e | e@(H.Entry p _) <- vds, p /= -1]
            loop dist prev queue2
```

# F - Sensor Optimization Dilemma

[問題 ABC325F](https://atcoder.jp/contests/abc325/tasks/abc325_f)

シグネチャを決める。$L_i, C_i, K_i$は手抜きする。

```haskell
abc325f :: Int     -- N
        -> [Int]   -- Di
        -> [Int]   -- L1, C1, K1
        -> [Int]   -- L2, C2, K2
        -> Int     -- 答え
```

## 考える

ある区画 $D_i$ に対して、二つのセンサを使う方法は、片方をいくつか（0を含む）使い、残りをもう一方で覆うだけ使う、複数のやり方がある。
<!--
ここで、例えば $D_i = 5, L_1 = 2, L_2 = 10$ とすると、センサ1を3個使うならセンサ2は0個でいいが、センサ1を減らしたとき、2,1,0個のいずれでもセンサ2は1つで済む。考える場合の数をなるべく減らすため、センサ1はセンサ2より短くないとする。
-->

区画を前から順に考えて、二つのセンサの残り個数のあり得る場合を全て考えて、その集合を更新するようにしてみる。

```haskell
import Data.List
import qualified Data.Set as S

abc325f _n ds [l1,c1,k1] [l2,c2,k2]
  | S.null s = -1
  | otherwise = minimum [(k1 - i) * c1 + (k2 - j) * c2 | (i,j) <- S.elems s]
  where
    s = foldl' step (S.singleton (k1,k2)) ds
    step s d = S.fromList
        [ (i - p, j - q)
        | p <- [0 .. divrup d l1]                 -- センサ1を使う個数
        , let q = divrup (max 0 $ d - p * l1) l2  -- センサ2を使う個数
        , (i,j) <- S.elems s
        , i >= p, j >= q ]                     -- センサが足りるように

-- 切り上げ除算
divrup :: Int -> Int -> Int
divrup x y = negate $ div (negate x) y
```

[思い切りTLEした。](https://atcoder.jp/contests/abc325/submissions/46856713)

場合が重複しないように `Set` を用いてはいるが、まだ無駄な場合を考えているらしい。
センサ1を$P$個使う場合で、センサ2を$Q_1, Q_2, Q_3$個使う3つの場合を別物として処理したが、これは最小のものだけ考えれば足りる。
そこで、`Set (Int,Int)` の代わりに、$P$をキー、$Q_i$の最小値を値に持つことで使う個数最小の場合だけ維持する `IntSet Int` で場合の集合を管理する。

```haskell
import Data.List
import qualified Data.IntMap as IM

abc325f :: Int -> [Int] -> [Int] -> [Int] -> Int
abc325f _n ds [l1,c1,k1] [l2,c2,k2]
  | IM.null im = -1
  | otherwise  = minimum [(k1 - i) * c1 + (k2 - j) * c2 | (i,j) <- IM.assocs im]
  where
    im = foldl' step (IM.singleton k1 k2) ds
    step im d = IM.fromListWith max               -- センサ2を最も残す場合のみを記録
        [ (i - p, j - q)
        | p <- [0 .. divrup d l1]
        , let q = divrup (max 0 $ d - p * l1) l2
        , (i, j) <- IM.assocs im
        , i >= p, j >= q ]
```

「センサの残り個数」とやらなくても、素直に「センサの使用数」で上限を $K_1, K_2$ で判定してもよかったと思う。

これで間に合ったので、公式解説のややこしい計算量競争は見なかったことにして終わりにする。

# G - offence

[問題 ABC325G](https://atcoder.jp/contests/abc325/tasks/abc325_g)

シグネチャを決める。

```haskell
abc325f :: String  -- S
        -> Int     -- K
        -> Int     -- 答え
```

解説を見たが、[アライさんは説明が端的すぎ](https://twitter.com/kyopro_friends/status/1715731544399401458)てそれだけではわからず、[公式解説](https://atcoder.jp/contests/abc325/editorial/7486)は言葉が独特なのか、読み込んでなんとか理解した。
すばらしいサーベイの『[DPの俗称](https://www.mathenachia.blog/dp/)』だけでは、どうDPしていいかわからない。

ということで、解釈していく。

## 考える

$S$ の $l$ 文字め（含む）から $r$ 文字め（含まない）までの連続する部分列のあらゆる場合について考える。$S$全体もその一種である。
任意の部分列について、問題の$S$と同様に操作を行って最も短い列を作り出せたとして、その長さを $len[l,r]$ とする。
また、その長さの列を作りだす操作の系列で、最後に行った操作が用いた `o` と `f` がどれか、を考える。

- (A) 操作は一度も行わない場合
このとき、列の長さは $r - l$ である。
- (B) 部分列の先頭が `o` で、これと、区間の中のいずれかの `f` が使われた場合。その位置を $m$ とする。
その操作が可能になるためには、`o`と`f`の間は操作により空列にできる必要がある。すなわち $len[l+1,m] = 0$ である。
また、`f`より後ろの文字列が他の操作で短縮され、最後にもう $K$ 文字だけ削ることができるので、最終的な長さは$len[m+1,r] - K$となる。ただし、負の数にならないように0でクランプする。
- (C) 先頭でない `o` が使われた場合。その位置を $m$ とする。
このとき、最終的な長さは $len[l,m] + len[m,r]$ となる。

場合(B)と(C)は、可能な $m$ を全て考え、これらの中の最小値が実際の $len[l,r]$ の値となる。

## 結果

遅延配列による集めるDPで実装する。
$len$は上対角行列のような形になるので、二重の配列にする。

```haskell
import Data.Array
import Data.List

abc325g :: String -> Int -> Int
abc325g s k = len ! 0 ! n
  where
    n = length s
    os = elemIndices 'o' s
    fs = elemIndices 'f' s
    len = listArray (0, n)
      [ listArray (l, n) $ map (lenF l) [l..n]
      | l <- [0..n] ]
    lenF l r = minimum $ cand1 : cand2 ++ cand3
      where
        cand1 = r - l                              -- (A)
        cand2 =                                    -- (B)
          [ max 0 (len ! succ m ! r - k)
          | s ! l == 'o'
          , m <- takeWhile (r >) $ dropWhile (l >) fs
          , len ! succ l ! m == 0 ]
        cand3 =                                    -- (C)
          [ len ! l ! m + len ! m ! r
          | m <- takeWhile (r >) $ dropWhile (l >=) os
          ]
```