ABC341をHaskellで

今週のでなくてもう一つ前のです。

---

# A - Print 341

[問題 ABC341A](https://atcoder.jp/contests/abc341/tasks/abc341_a)

シグネチャを決める。

```haskell
abc341a :: Int    -- N
        -> String -- 答え
abc341a n = take (n + succ n) $ cycle "10"
```

$2N+1$文字の、`1010...1` を出力すればよい。

# B - Foreign Exchange

[問題 ABC341B](https://atcoder.jp/contests/abc341/tasks/abc341_b)

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

```haskell
abc341b :: Int     -- N
        -> [Int]   -- Ai
        -> [[Int]] -- Si, Ti
        -> Int     -- 答え
```

回数もどれを両替するかも自由に選んでよい、と言われても、$i$から$i+1$にしか両替できないので、順にやるしかないのでそうするだけ。

## 結果

これまでの前からの両替で$i$の通貨を `acc` 枚作ったとき、さらに手持ちの$A_i$を加えて、$T_i / S_i$のレートで$i+1$に両替する。

$A_i$は$N$個、$S_i,T_i$は$N-1$個で都合が悪いので、手っ取り早く自前のループで済ませる。

```haskell
abc341b :: Int -> [Int] -> [[Int]] -> Int
abc341b n as sts = loop 0 as sts
  where
    loop :: Int -> [Int] -> [[Int]] -> Int
    loop acc [an] [] = acc + an
    loop acc (ai:as) ((si:ti:_) : sts) = loop (ti * div (acc + ai) si) as sts
```

両替と手持ちを足して$i$の通貨を`acc`枚持っているとき、これを$T_i/S_i$のレートで$i+1$に両替し、さらに$A_{i+1}$を足して$i+1$の通貨にする、と手順を修正すれば`foldl`に乗った。

```haskell
abc341b n (a1:as) sts = foldl step a1 $ zip as sts
  where
    step acc (ai, si:ti:_) = ai + ti * div acc si
```

# C - Takahashi Gets Lost

[問題 ABC341C](https://atcoder.jp/contests/abc341/tasks/abc341_c)

シグネチャを決める。

```haskell
abc341c :: Int      -- H
        -> Int      -- W
        -> Int      -- N
        -> String   -- T
        -> [String] -- Si
        -> Int      -- 答え
```

$H,W,N \leq 500$なので、全ての地点から開始して、最後まで無事で居られるかをシミュレーションするのにかかる時間は $500^3 = 125,000,000 = 1.25 * 10^8$ なので間に合う。

## 結果

地図の周囲は必ず海なので、マップをはみ出す前に海に落ちるから `inRange bnds ij` は冗長。

```haskell
import Data.Array

abc341c :: Int -> Int -> Int -> String -> [String] -> Int
abc341c h w _n t ss = length
  [ ()
  | i0 <- [1..h], j0 <- [1..w]       -- 全ての位置から開始して
  , let ijs = scanl walk (i0, j0) t  -- 移動した座標列
  , all onLand ijs                   -- マップをはみ出さず、海にも落ちない
  ]
  where
    bnds = ((1,1),(h,w))
    fld = listArray bnds $ map ('.' ==) $ concat ss -- 陸地ならTrueの地図
    onLand ij = inRange bnds ij && fld ! ij

    walk (i,j) 'L' = (i, pred j)
    walk (i,j) 'R' = (i, succ j)
    walk (i,j) 'U' = (pred i, j)
    walk (i,j) 'D' = (succ i, j)
```

# D - Only one of two

[問題 ABC341D](https://atcoder.jp/contests/abc341/tasks/abc341_d)

シグネチャを決める。

```haskell
abc341d :: Int -- N
        -> Int -- M
        -> Int -- K
        -> Int -- 答え
```

二分探索の条件を設定するのが苦手で、解説を見ないとACできなかった。

## 自分の考えたやり方

$G = \gcd(N,M), L = \textrm{lcm}(N,M), N = nG, M = mG$ とおく。すると$L = nmG$である。
1から $L$ までの間に、$N$で割りきれる数は$m$個、$M$で割りきれる数は$n$個あり、最後の一つが最大公約数、それ以外はいずれか一方のみの倍数である。つまり問題の条件にあう数は$n-1 + m-1$個ある。

$L$周期でこの様子が繰り返されるので、$K-1$を$n+m-2$で割った商を$q$ 余りを$r$とすると、（0始まりで)$q$ブロックめの（0始まりで)$r$個めの倍数が求める数である。

ブロック内の$r$個めの倍数は、$iN \\ (i = 1, \dots m-1)$ か $jM \\ (j = 1, \dots n-1)$ のいずれかで、前者は $i - 1 + \lfloor iN / M \rfloor$ 個め、後者は $j - 1 + \lfloor jM / N \rfloor$個めである。どちらかでちょうど$r$になる$i,j$を二分探索で探す。
もしくは$x = 1, \dots, L-1$ 以下の$N$または$M$の倍数の個数は $\lfloor x / N \rfloor + \lfloor x / M \rfloor$なので、これが$r$以上になる最小の$x$を二分探索で探す。

[⇒提出](https://atcoder.jp/contests/abc341/submissions/50472875)

## 公式解説

[公式解説 by mechanicalpenciI](https://atcoder.jp/contests/abc341/editorial/9324)のやり方はもっと大胆に、任意の$X$以下の$N$の倍数の個数は$\lfloor X / N \rfloor$個、$M$の倍数の個数は$\lfloor X / M \rfloor$個、両者にそれぞれ$L$の倍数が$\lfloor X / L \rfloor$個数えられているのでこれを引けば問題で数えたい倍数の個数になるので、これがちょうど$K$になる$X$を、解の可能性のある範囲全体から一気に二分探索する、というもの。

これは自分のアイデアの後半を拡大したものに相当する。

[⇒提出](https://atcoder.jp/contests/abc341/submissions/50474078)
さすが二分探索、探索範囲を$L$に絞っている上の方法と実行時間が変わらない。

## ユーザ解説

[ユーザ解説 by  tatyam](https://atcoder.jp/contests/abc341/editorial/9334) は、前半は自分のアイデアと同様にして、残り$r$個を数えるとき、直接前から数えてしまえというもの。等差数列二つをマージソートのマージで統合して、前から数えるだけなのでコードはごく簡単。

前から数えるので（最悪の場合の$G=1$を考えて）$O(K)$ となり、$K \leq 10^{10}$なので時間が厳しいように見える。

[⇒提出](https://atcoder.jp/contests/abc341/submissions/50474032)

# E - Alternating String

[問題 ABC341E](https://atcoder.jp/contests/abc341/tasks/abc341_e)

<!--
シグネチャを決める。

```haskell
abc341e :: Int     -- N
        -> Int     -- Q
        -> String  -- S
        -> [[Int]] -- query_i
        -> [Bool]  -- 答え
```
-->

## ゾルトラークだ！

区間を反転、と言っているので、これは区間更新セグメント木で決まりでしょう、と考えた。

ある区間の列は、この「良い文字列」という観点から次のように分けられる。

```haskell
data Entry
  = Null            -- 空列
  | Bad             -- 良い列でない
  | Good Bool Bool  -- 良い列 先頭が'1'か 末尾が '1' かの４とおり
```

最後のものは、長さ1についても統一的に扱うためにこうした。

セグメント木の演算としては、`Null`を単位元とする連結操作を設定する。

```haskell
con :: Entry -> Entry -> Entry
con (Good a b) (Good c d) | b /= c = Good a d  -- 良い列どうしがうまく繋がるとき、結果は良い
con Null x = x  -- 空列を繋いでも変化なし
con x Null = x
con _ _ = Bad   -- Badまじりまたは、良い列どうしだが繋ぎ方が良くないとき
```

区間更新の演算は、0と1の反転。これを適用した回数が奇数回のとき反転し、偶数回のときは元のまま。
つまり、反転をするかしないかは `Bool` ひとつで記憶でき、重ねるのは `xor` でできる。

```haskell
inv :: Bool -> Entry -> Entry
inv True (Good a b) = Good (not a) (not b) -- 反転をするとき、Goodは反転できる
inv _ x = x -- 反転をさせないとき、またはGoodでないものの反転は結果は変わらずになる
```

という方針で実装したが、[どうも実行時間が足らない。](https://atcoder.jp/contests/abc341/submissions/50517949)

## 「ハンマーを持つ人にはすべてが釘に見える」(If all you have is a hammer, everything looks like a nail.)

（Tiger & Bunny のサブタイトルみたい）

[アライさんいわく](https://twitter.com/kyopro_friends/status/1758853632177619020)
> 「S[i]=S[i+1]ならA[i]=0、S[i]≠S[i+1]ならA[i]=1」の配列Aを考えると、1点更新区間和取得が高速にできればいいからセグ木でできるのだ！

あーそういう。

- $A[1\leq i < N]$を、$S[i]$と$S[i+1]$が互いに違う文字であるとき1、という値にして、
- クエリ2では $A[L,R)$の総和が$r-l$なら、全ての狭間が互いに違うので良い文字列とわかる
- クエリ1では
  - $S[L～R]$の反転させても$A[L,R)$の値は変化なし
  - $A[L-1]$と$A[R]$は、片方だけが反転させられるから0と1を入れ替える

これなら計算時間も余裕で間に合いましたハイ。
[⇒提出](https://atcoder.jp/contests/abc341/submissions/50518836)

## セグメント木すら不要

[セグメント木を用いない解法 by  hitoare](https://atcoder.jp/contests/abc341/editorial/9338) がスマートすぎ。むしろこっちを本命にするべき。

- $S[i]$と$S[i+1]$が同じ文字、つまり正しくない繋がりの位置$i$をもつ整数集合を状態とする
- クエリ2では、集合が$[L,R-1]$を含まないとき、その区間はよい文字列
- クエリ1では、$L-1$と$R$について、整数集合に含まれていたら除き、なければ追加する

なるほど確かにこれだけでいい。

```haskell
abc341e :: Int -> Int -> BS.ByteString -> [[Int]] -> [Bool]
abc341e n _q s qs = loop is0 qs
  where
    is0 = IS.fromDistinctAscList
          [i | i <- [1..pred n], BS.index s (pred i) == BS.index s i]
    loop _ [] = []
    loop is ((1:l:r:_):qs) = loop (toggle r $ toggle (pred l) is) qs
    loop is ((2:l:r:_):qs) = res : loop is qs
      where
        res = case IS.lookupGE l is of -- L以上の最小の要素xが
                Just x  -> r <= x      -- R以上ならヨシ
                Nothing -> True        -- 無いならヨシ

toggle :: Int -> IS.IntSet -> IS.IntSet
toggle x is
  | IS.member x is = IS.delete x is
  | otherwise      = IS.insert x is
```

ただ、消費メモリはこちらの方が多くかかった。

# F - Breakdown

[問題 ABC341F](https://atcoder.jp/contests/abc341/tasks/abc341_f)

シグネチャを決める。

```haskell
abc341f :: Int     -- N
        -> Int     -- M
        -> [[Int]] -- ui, vi
        -> [Int]   -- Wi
        -> [Int]   -- Ai
        -> Int     -- 答え
```

$W_i$をそれぞれの頂点の高さとイメージして、石はより低い位置にだけ転がっていくが、選んだ$S$の頂点全てに分身する、という感じ。
どん底になっている頂点からは、操作につき石か一つ失われるだけで増えることはない。
配る先がある頂点からの操作でも、より低い位置にしか移らないので、操作がループになることなく、向きは固定になる。
とすると、ある頂点にあるひとつの石をどう操作したら、最大の操作回数が得られるかは、石の配置状況には影響されずに、グラフの構造だけから一意に決定できる。

頂点$v$のひとつの石を消すのに$C[v]$回の操作が必要になるとする。
どん底の頂点$b$については$C[b] = 1$である。
頂点$v$の周囲のより低い頂点を適切に選んだ集合を$S_v$として、$C[v] = 1 + \sum_{u \in S_v} C[u]$ となる。

$S_v$を選ぶには、$\sum_{u \in S} W_u \leq W_v$ という制約のもとで $\sum_{u \in S} C[u]$ を最大にするものを選ぶ。つまりナップザック問題である。
どん底も$S=\emptyset$といえるので統一的に計算できる。

相互再帰するように見えるが、より低い方から$C[u]$を確定させていけば、決定済みの情報だけを参照して決めていける、というのが命令型言語での解法になるのだろう。

$C[\cdot]$が全て決まれば、求める答えは積和 $\sum_v A_v \cdot C[v]$ である。

## 結果

個々のナップザック問題を解くには、頂点$v$について、選択した隣接頂点の集合 $S$ について、その重さの和 $\sum_{u \in S} W_u$ （上限 $W_v - 1$）をキーに、価値の総和 $\sum_{u \in S} C[u]$ を値にした表$T[w]$を更新するDPをする。初期値は$T[0]=0$だけを持ち、$u$について、存在する表の要素$T[w]=c$について、$T[w+W_u] = \max(T[w+W_u], c + C[u])$ と更新する。

この表を配列で実現すると、要素数は$W_i \leq 5000$程度だが、全体を$N$回舐める必要があり重すぎる。
「コストを$w$かけて成果が$c$」と考えると、単調増加になるはずで（より高いコストをかけるのに結果がしょぼいやり方は意味がない）、配列でなく`IntMap`で管理し、値を挿入しようとするとき、より低いものが超越しているなら挿入しない、挿入した値がより大きなコストのものより優秀なら、その劣った先輩たちを引退させることで単調増加を保つ。

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

abc341f :: Int -> Int -> [[Int]] -> [Int] -> [Int] -> Int
abc341f n _m uvs ws as = sum $ zipWith (*) as $ elems score
  where
    g = accumArray (flip (:)) [] (1,n) [p | u:v:_ <- uvs, p <- [(u,v),(v,u)]] -- 隣接頂点リスト
    w = listArray (1,n) ws -- Wiの配列
    score = listArray (1,n) $ map solve [1..n]  -- 暗黙のDP
    solve i = succ $ IM.foldl max 0 $  -- 頂点iのスコアはDPの結果の最大値+1
              foldl step (IM.singleton 0 0) -- より低い隣接頂点を全て検討する
              [(wj, score ! j) | j <- g ! i, let wj = w ! j, wi > wj]
      where
        wi = w ! i
        step im (wj, aj) = foldl ascInsert im  -- 頂点jを入れてみる
          [ (wsum + wj, asum + aj)
          | (wsum, asum) <- IM.assocs im
          , let wsum1 = wsum + wj, wsum1 < wi]

ascInsert :: Ord a => IM.IntMap a -> (Int, a) -> IM.IntMap a
ascInsert im (k, v) =  -- 単調増加を保ってimに(k,v)を挿入する
  case IM.lookupLE k im of
    Just (_, v0) | v0 >= v -> im -- 無意味な(k,v)は却下
    _ -> after $ IM.insert k v im
  where
    after im =
      case IM.lookupGT k im of
        Just (k1, v1) | v >= v1 -> after $ IM.delete k1 im -- 劣た先輩を引退させる
        _ -> im
```

引退させる先輩を一人一人調べる代わりに、逆写像も維持しておくとそれで範囲を一度に確定させることもできそうだが、現状で間に合ったし、`IM.split` で分割して…とコードがややこしくなるので敬遠してしまった。

# G - Highest Ratio

[問題 ABC341G](https://atcoder.jp/contests/abc341/tasks/abc341_g)

シグネチャを決める。

```haskell
abc341g :: Int      -- N
        -> [Int]    -- Ai
        -> [Double] -- 答え
```

塩水問題？と頓珍漢なことを考えるばかりでさっぱりわからないのでヒントを貰う。

[アライさんいわく](https://twitter.com/kyopro_friends/status/1758857896484565361)
> Aの累積和を求めておいて、適当に変数変換すると「(Si-Sk)/(i-k)の最大値は？」になるから、kが大きい順に、凸包を求めるときみたいにくぼんでる点を飛ばしながら持っておけばいいのだ！

これだけの説明ではわからず、公式解説も難しい言葉を使っていて、サンプルコードと合わせて読み解くと、

- 番号$i$をX座標、累積和$\sum_{j=1}^i A_j$をY座標とした点$P_i$の列を考える。$P_0=(0,0)$とする
- $k$について求める値は、$P_{k-1}$から$P_j \\ (k \leq j \leq N)$ への傾きの最大値
- $k$より右にある全ての点を毎回考えると遅い
- 点列の並びが、左にカーブしているとき、凹んでいるということで不要
- 一度不要と判定された点は、$k$がより小さい値について考えるときも、二度と考慮する必要はない
- 右にカーブしている点は、膨らんでいるので、まだ必要
- 右にカーブしているということは、$k-1$から見た傾きは緩やかになるので、一番手前のものだけを考えればよい

ということのようだ。

## 結果

Y座標は相対値だけが必要になるので、素直に前からの累積和とする必要はなく、後ろから考えるとき、引いていけば同じ結果が得られる。
「まだ不要と判定されていない点列（X座標順）」の先頭は$P_k$になるので、ここから$P_{k-1}$が作れる。ループするときにこれを別に渡す必要はない。

```haskell
type State = [(Int,Int)]

abc341g :: Int -> [Int] -> [Double]
abc341g n as = snd $ mapAccumR step [(n, 0)] as
  where
    step :: State -> Int -> (State, Double)
    step xys@((x1,y1) : _) dy = loop xys
      where
        x0 = pred x1
        y0 = y1 - dy
        loop ((x1,y1) : (x2,y2) : xys)
          | (y1 - y0) * (x2 - x0) <= (y2 - y0) * (x1 - x0) = loop ((x2,y2) : xys) -- (*1)
        loop xys@((x1,y1) : _) =
          ( (x0,y0) : xys
          , fromIntegral (y1 - y0) / fromIntegral (x1 - x0)) -- (*2)
```

(*1)は、$(x_0,y_0)$から見た$(x_1,y_1)$の傾きより$(x_2,y_2)$の傾きがそれ以上になっているか、$\displaystyle \frac{y_1 - y_0}{x_1 - x_0} \leq \frac{y_2 - y_0}{x_2 - x_0}$ を判定して、そのとき$(x_1,y_1)$を候補から除外している。
(*2)は、候補列の最も手前の点との傾きを今回の答えとしている