ABC258 A～E をHaskellで

# A - When?

[問題 ABC258A](https://atcoder.jp/contests/abc258/tasks/abc258_a)

シグネチャを決める。

```haskell
abc258a :: Int -> String
```

小手先の技の類だが、数値表記の余った上の桁に0を追加するには、確実に対象の数より大きい数を足してから`show`して、上位桁の文字を切り飛ばすというやり方がある。

```haskell
-- 0から99を "00"～"99" にする
show2d :: Int -> String
show2d x = tail $ show $ x + 100
```

## 結果

```haskell
abc258a k = show (h + 21) ++ ':' : show2d m
  where
    (h,m) = divMod k 60

show2d :: Int -> String
show2d x = tail $ show $ x + 100
```

# B - Number Box

[問題 ABC258B](https://atcoder.jp/contests/abc258/tasks/abc258_b)

シグネチャを決める。$A_{i,j}$ は `Char` で持っておくことにする。

```haskell
abc258b :: Int       -- N
        -> [[Char]]  -- Aijの並んだリストのリスト ass
        -> Int       -- 答え
```

スタート地点が最大 $N^2 = 100$か所、進行方向がそれぞれ8通りなので、800個の候補を全て作って最大値を選べばよい。

行 $[A_{k,1}, A_{k,2}, \dots , A_{k,N}]$ の任意の位置から右方向に8桁取り出すには、`cycle` するところから始める。

```haskell
horizontal :: [Char] -> [[Char]]
horizontal = take n . map (take 8) . tails . cycle
```

この結果を全て `reverse` すれば、左方向のものが得られる。
`transpose ass` の各要素にそれを行えば、下方向と上方向が得られる。

`ass` の各行を `cycle` しておいて、これを「第 $i$ 行は $i$ 文字捨てる」と行をだんだんずらして、長さ $N$ に切り詰めてから `transpose` すると、左下から右上向きの列を取り出すことができる。

```haskell
dl2ur :: [Char] -> [[Char]]
dl2ur ass = transpose $ map (take n) $ zipWith drop [0..] $ map cycle ass
```

ずらし方を逆にすれば左上から右下向きの列を取り出せる。

```haskell
ul2dr :: [Char] -> [[Char]]
ul2dr ass = transpose $ map (take n) $ zipWith drop [n-1,n-2..] $ map cycle ass
```

少し計算の順序などを変えて整えて完成。

## 結果

```haskell
abc258b :: Int -> [String] -> Int
abc258b n ass = maximum [h, v, d, b]
  where
    h = g                 ass
    v = g $ transpose     ass
    d = g $ h [0..]       ass
    b = g $ h [n-1,n-2..] ass
-- 1行についてN箇所から左右に調べる
    f = maximum . map (\s -> max (read s) (read $ reverse s)) .
        map (take n) . take n . tails . cycle
-- 全ての行についてfを行う
    g = maximum . map f
-- 列をdsで指定したように斜めにずらす
    h ds = transpose . map (take n) . zipWith drop ds . map cycle
```

# C - Rotation

[問題 ABC258C](https://atcoder.jp/contests/abc258/tasks/abc258_c)

シグネチャを決める。

```haskell
abc258c :: Int -> Int   -- N, Q
        -> String       -- S
        -> [(Int,Int)]  -- queryのリスト
        -> [Char]       -- 答え
```

実際に文字列を操作すると大変なことになるので、その代わりに、現在の先頭が最初の位置から何文字ずれているか、というオフセット $p$ を管理する。循環するので位置は $\bmod N$ で考える。もちろん0始まり。
$1 \\; x$ により、オフセットはさらに $x$ 減る。
$2 \\; x$ では、$(p + x - 1) \bmod N$の位置の文字を出力する。

## 結果

```haskell
import quarified Data.Vector.Unboxed as UV

abc258c n q s txs = loop 0 txs
  where
    v = UV.fromList s
    loop _ [] = []
    loop p ((1,x):txs) = loop (mod (p - x) n) txs
    loop p ((2,x):txs) = v UV.! mod (p + x) n : '\n' : loop p txs
```

# D - Trophy

[問題 ABC258D](https://atcoder.jp/contests/abc258/tasks/abc258_d)

シグネチャを決める。

```haskell
abc258d :: Int -> Int   -- N, X
        -> [(Int,Int)]  -- A,Bのペアのリスト
        -> Int          -- 答え
```

先のステージに進むのは、最も短時間でクリアできるステージを開放するためで、それを開放した後は、ひたすらそのステージで回数を稼ぐ、という戦略が最適とわかる。ステージ $j$ まで開放しておいて、それより手前のステージ $i < j$ に戻って何度かプレイすることに、消費時間を短くするという目標に関するメリットはない。

ステージ $i$ までを一度ずつクリアして先に進み、そのステージ $i$ を残り $X-i$ 回プレイして $X$ 回を達成したときの消費時間を全て求めると、その最小値が答えとなる。
「一度ずつクリア」の消費時間は $A_i + B_i$ の累積和で簡単に得られる。

## 結果

```haskell
abc258d n x abs = minimum $ zipWith (+) ps qs
  where
    abs1 = take x abs1
    ps = scanl1 (+) $ map (uncurry (+)) abs1
    qs = zipWith (*) [n-1,n-2..] $ map snd abs1
```

# E - Packing Potatoes

[問題 ABC258E](https://atcoder.jp/contests/abc258/tasks/abc258_e)

シグネチャを決める。

```haskell
abc258e :: Int -> Int -> Int  -- N,Q,X
        -> [Int] -> [Int]     -- Wi, Ki
        -> [Int]              -- 答え
```

$10^{100}$という数は、芋は尽きることはないと言っている。
要素は多いが、一つ一つはそれほど難しい問題ではないので、順に片づけていこう。

それぞれの箱に入っているじゃがいもの個数を求める必要がある。
重さの系列が $N$ で循環することから、芋の並びにおける先頭からの位置を、0始まりで $\bmod N$ で考える。
位置 $p$ から詰め始めた箱に芋がいくつ入るかは、$X$ 以上になるまで足しこんでいけば調べられる。それを与える配列 $p2n[0 \leq p < N]$ は、尺取り法ですると効率的に作れそうである。
しかし油断は禁物、$X \leq 10^9, 1 \leq W_i$ なので、重さ$1$の芋を$10^9$個箱詰めすることになる恐れがある。そうならないように、一周分の重さの剰余だけ考えることにする。

```haskell
(xq,xr) = divMod x (sum ws)
```

重さ $xr$ は尺取り法で $N$ 個以内に確実にとることができ、そうして数えた個数に対して、実際の個数は $+ \\, xq \cdot N$ した値になる。

尺取り法は、区間の重量が $xr$ 以上になったとき、左端の位置と区間の長さを対にして出力し、左を縮める。重量が不足しているなら、右に伸ばす。左が一周分使い切ったら完了である。

```haskell
catapillar xr ws = loop (zip [0..] ws) 0 0 (ws ++ ws)
  where
    loop ilils@((i,l):ils) cnt acc rrs@(r:rs)
      | acc >= xr = (i, cnt) : loop   ils (pred cnt) (acc - l) rrs
      | otherwise =            loop ilils (succ cnt) (acc + r)  rs
    loop [] _ _ _ = []
```

位置 $N-1$ 近い終盤から始まって、次の周回にはみ出すような区間も数えられるように、右側は `ws` をもう一度繰り返している。

この関数により、開始位置と芋の個数の対が位置の順に出力されるので、これを `array` で配列に入れる。つもりだったが、`catapillar` は添え字の順に結果を出すので、添え字を付ける必要もなかったし、`Vector` に入れることもできそうなのでそうしよう。

```haskell
p2n = UV.fromList $ loop ws 0 0 (ws ++ ws)
  where
    loop lls@(l:ls) cnt acc rrs@(r:rs)
      | acc >= xr = cnt : loop  ls (pred cnt) (acc - l) rrs
      | otherwise =       loop lls (succ cnt) (acc + r)  rs
    loop [] _ _ _ = []
```

$p2n[\cdot]$ は芋を詰める開始位置に対する芋の個数なので、ここから、箱を（0始まりで）何個目の箱に入る芋の開始位置がどこかという情報を構築する。先頭の箱は位置0から始まり、次の箱は、位置0の箱の芋の個数だけずれた位置から始まり、その次の箱はまた芋の個数を足しただけズレた位置から…となる。これを、開始位置の無限リストにしてみる。

```haskell
ps = iterate (\p -> mod (p + p2n UV.! p) n) 0
```

この系列は、要素が $N$ 種類しかなく、次の要素は固定なので、確実に $N$ 以内にループする。しかし、ループは先頭に戻るとは限らない。実際、問題文に示された例1では 0, 2, 2, 2, ... となっている。
$ps$ を前から調べて各位置 $p$ が $ps$ のいくつめに出現したか、という表を作り、このときに重複した出現が見つかったとき、そこで循環になっている。これはmutable vectorで計算した方がよさそう。

```haskell
k2pAction :: ST s (Int, Int, UV.Vector Int)
k2pAction =
  do
    p2k <- MUV.replicate n notyet
    k2p <- MUV.new n
    loop p2k k2p 0 ps
  where
    notyet = -1
    loop p2k k2p k (p:ps) = do
      k1 <- MUV.read p2k p
      if k1 == notyet then do
        MUV.write p2k p k
        MUV.write k2p k p
        loop p2k k2p (succ k) ps
      else do
        k2pi <- UV.freeze k2p
        return (k1, k - k1, k2pi)
```

開始位置 $p$ の今回の出現が $k$ 箱め、前回の出現が $k_1$ 箱めならば、先頭から $k_1$ 箱まではループせず、そこから $k - k_1$ 箱の長さのループが形成されている。
![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/196351/c35a567e-31c8-eedb-043d-d7f6f972c6bb.png)

ここまで来たら、`k2pAction` の返す内容「ループ前の箱の個数」「ループの箱の個数」「箱の番号から芋の開始位置へのimmutableベクタ（ただしループ終わりまで）」を使って、それぞれのクエリ $K$ に答えることができる。

```haskell
(k1,k2,k2p) = runST k2pAction
f k
  | k <= k1   = xq * n + p2n UV.! (k2p UV.! k)
  | otherwise = xq * n + p2n UV.! (k2p UV.! (k1 + mod (k - k1) k2))
```

## 結果

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

abc258e :: Int -> Int -> Int -> [Int] -> [Int] -> [Int]
abc258e n q x ws ks = map (f . pred) ks
  where
    (xq,xr) = divMod x (sum ws)

    p2n = UV.fromList $ loop ws 0 0 (ws ++ ws)
      where
        loop lls@(l:ls) cnt acc rrs@(r:rs)
          | acc >= xr = cnt : loop  ls (pred cnt) (acc - l) rrs
          | otherwise =       loop lls (succ cnt) (acc + r)  rs
        loop [] _ _ _ = []
    ps = iterate (\p -> mod (p + p2n UV.! p) n) 0

    f k
      | k <= k1   = xq * n + p2n UV.! (k2p UV.! k)
      | otherwise = xq * n + p2n UV.! (k2p UV.! (k1 + mod (k - k1) k2))

    (k1,k2,k2p) = runST (
      do
        p2k <- MUV.replicate n notyet
        k2p <- MUV.new n
        loop p2k k2p 0 ps
      )
      where
        notyet = -1
        loop p2k k2p k (p:ps) = do
          k1 <- MUV.read p2k p
          if k1 == notyet then do
            MUV.write p2k p k
            MUV.write k2p k p
            loop p2k k2p (succ k) ps
          else do
            k2pi <- UV.freeze k2p
            return (k1, k - k1, k2pi)
```

いろいろやらかした備忘録：

- 初めは「$+ \\, xq \cdot N$ する」を忘れて `WA` になった。
- 書き直したとき、尺取り法のリミット値を $xr$ にするのを忘れて $X$ にして右側をオーバーランさせた。
- その上 $xr$ の名前を `r` にしたせいで、尺取り法の右側 `r:rs` と変数名を被らせて謎のエラーを起こした。