ABC356 A～F をHaskellで

# A - Subsegment Reverse

[問題 ABC356A](https://atcoder.jp/contests/abc356/tasks/abc356_a)

シグネチャを決める。

```haskell
abc356a :: Int -- N
        -> Int -- L
        -> Int -- R
        -> [Int] -- 答え
```

L未満、LからR、R超、の3つの部分に分けて考えればよい。

## 結果

```haskell
abc356a n l r = [1 .. pred l] ++ [r, pred r .. l] ++ [succ r .. n]
```

第i項を直接求めることもできる。

```haskell
abc346a n l r = [if l <= i && i <= r then l + r - i else i | i <- [1 .. n]]
```

# B - Nutrients

[問題 ABC356B](https://atcoder.jp/contests/abc356/tasks/abc356_b)

シグネチャを決める。

```haskell
abc356b :: Int     -- N
        -> Int     -- M
        -> [[Int]] -- Xij
        -> Bool    -- 答え
```

項目ごとに総和をとり、$A_i$ 以上になることを確認する。

## 結果

```haskell
import Data.List

abc356b :: Int -> Int -> [Int] -> [[Int]] -> Bool
abc356b _n _m as = and . zipWith (<=) as . map sum . transpose
```

# C - Keys

[問題 ABC356C](https://atcoder.jp/contests/abc356/tasks/abc356_c)

シグネチャを決める。

```haskell
abc356c :: Int     -- N
        -> Int     -- M
        -> Int     -- K
        -> [(Int,[Int],Char)] -- Ci, Aij, Ri
        -> Int     -- 答え
```

$N \leq 15$ なので、二進数のビット1を「正しい鍵」として、それぞれのテスト設定とbitwise ANDをとって `popCount` した結果が K 以上かと、R が一致するような数の個数を数える。

## 結果

```haskell
import Data.Bits

abc356c :: Int -> Int -> Int -> [(Int,[Int],Char)] -> Int
abc356c n _m k cars = length [() | x <- [0 .. 2^n - 1], prop x]
  where
    as2m :: [Int] -> Int
    as2m = flip shiftR 1 . sum . map bit -- Aijのビットを立てたマスクを作る
    mbs = [(as2m as, r == 'o') | (_c, as, r) <- cars] -- テストのマスクと結果のリスト
    prop x = and [(popCount (m .&. x) >= k) == b | (m, b) <- mbs] -- 全てのテストが矛盾しない
```

# D - Masked Popcount

[問題 ABC356D](https://atcoder.jp/contests/abc356/tasks/abc356_d)

シグネチャを決める。

```haskell
abc356d :: Int  -- N
        -> Int  -- M
        -> Int  -- 答え
```

2進数での桁DP!?と焦ったけれど、D問題では出ないかな、とダメな視点で否定。

0からNまでのN+1個の数を、2進数で、縦に並べて書き出してみる。
0始まりでi桁め、重み $2^i = w$ の桁を縦に見ると、0が $w$ 個、1が $w$ 個、の繰り返しになっている。

```
10 | 1 0 1 0
 9 | 1 0 0 1
 8 | 1 0 0 0
 7 | 0 1 1 1
 6 | 0 1 1 0
 5 | 0 1 0 1
 4 | 0 1 0 0
 3 | 0 0 1 1
 2 | 0 0 1 0
 1 | 0 0 0 1
 0 | 0 0 0 0
       ↑ ↑ ^- 1個ずつ 0 1 0 1 ...
       | +--- 2個ずつ 0 0 1 1 ...
       +----- 4個ずつ 0 0 0 0 1 1 1 1 ...
```

0からNまでに、$2^i = w$ の位にある1の個数は、$2w$ 個ごとのブロックで考えると、完全なブロック1つにつき $w$ 個、最後の不完全なブロックには $w$ を越えた分にのみ1があるので、$(N+1) \div (2w) = q \dots r$ として $2q + \min(0, r - w)$ であるとわかる。

これのうち、$M$ のビットが1なものだけ数えればよい。

## 結果

```haskell
import Data.Bits

abc356d :: [Int] -> Int
abc356d [n, m] = summ
  [ add (mul q w) (max 0 (r - w))
  | w <- take 60 $ iterate (2 *) 1
  , m .&. w /= 0
  , let (q, r) = divMod (succ n) (2 * w)
  ]

modBase = 998244353
reg x = mod x modBase
mul x y = reg $ reg x * reg y
add x y = reg $ x + y
summ = foldl' add 0
```

$q$ は結局 $N+1$ の $i+1$ ビット右シフト、$r$ は $N+1$ の下位 $i+1$ ビットなので、`divMod` を使わなくても求められる気がする。

# E - Max/Min

[問題 ABC356E](https://atcoder.jp/contests/abc356/tasks/abc356_e)

シグネチャを決める。

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

~~（注：遅すぎる解法でした）~~

問題文の要求では、$A_i / A_i = 1$ は算入しないようにしないといけないが、一旦それも含めて数えて、後で引くことにする。
また、$A_i$ は昇順になっているとする。
$X_{i,j} = \big \lfloor \frac{\max(A_i,A_j)}{\min(A_i,A_j)} \big \rfloor$ とおく。
この式はつまり、小さい方を分母に、大きい方を分子に持ってきて割り算せよということ。
ある $A_i$ について、それが分母になるような $X_{i,j}$ は、整列済なら $i < j$ なものとわかる。
$\sum_{j=i}^N X_{i,j} = \sum_{j=i}^N \big \lfloor \frac{A_j}{A_i} \big \rfloor$

$Y_{i,j} = \big \lfloor \frac{A_j}{A_i} \big \rfloor$ とおく。
$Y_{i,j}$ は、$A_i$ の最大値を $A_\max$ として
- $A_i \leq A_j$ ならば1、ただしそれ以前に
- $2A_i \leq A_j$ ならば2、ただしそれ以前に
- …
- $kA_i \leq A_j$ ならば$k$、ただしそれ以前に
- …
- $k A_i \leq A_\max$ な$k$の間これが続く

という値になる。これを排他的な「ただし」でなく、成立するものを全て並列して受け入れて
- $A_i \leq A_j$ ならば1与える
- $2A_i \leq A_j$ ならばもう1与える
- …
- $kA_i \leq A_j$ ならばもう1与える
- …
- $k A_i \leq A_\max$ な$k$の間これが続く

として与えられた数の総和で求められる。
よって、$\sum Y_{i,j}$ を、$j$ について回す代わりに $k$ について回して

```math
\sum_{j = i}^N Y_{i,j} = \sum_{k=1}^{A_\max \div A_i} (k A_i \leq A_j を満たす j の個数)
```

配列に $A_i$ を入れておいて二分探索で添え字を探してそこから個数を見るか、$A_i$ についてそれ以上の要素の個数を持つ `IntMap` を作っておくかすれば、この計算は実行できる。

最後に、$A_i = A_j = A_k = \dots$ のように同じ値が被ったときも含めて、また $Y_{i,i} = 1$ まで数えてしまった分を引いて補正をする必要がある。
同じ値が $m$ 個あったとき、上の手順では $m^2$ を数えている。しかし本来は $\_mC2 = m(m-1)/2$ だけ数えるべきなので、差の $m^2 - (m(m-1)/2) = m(m + 1)/2$ を引く。

## 結果

```haskell
import qualified Data.IntMap as IM

abc356e :: Int -> [Int] -> Int
abc356e n as =
  sum [ m * maybe 0 snd (IM.lookupGE c im)
      | (k,m) <- IM.assocs im0
      , c <- [k, k+k .. amax]]                   -- cは解説の k * Ai
  - sum [div (m * succ m) 2 | m <- IM.elems im0] -- 補正
  where
    im0 = IM.fromListWith (+) [(a, 1) | a <- as] -- Ai -> その個数
    im = IM.mapWithKey imf im0                   -- Ai -> Ai以上のAjの個数
    imf k v = v + maybe 0 snd (IM.lookupGT k im)
    (amax,_) = IM.findMax im0                    -- Amax
```

$A_i$が小さいときに `c` の刻みが多すぎてTLEするかと心配したが間に合ったのでヨシ！

## 公式解説のやり方

上の解は [1592ms](https://atcoder.jp/contests/abc356/submissions/54222056)、対して公式解説のwriter解は Python で 216ms, C で 55ms これはまずい。

解説を読んだけれど、方針はほぼ同じ。

> あらかじめ $C$ の累積和を計算しておくことで $f(d,n)$ は $O(1)$ で求めることができます。

この $f(d,n)$ は「$A_j \div d = n$ となる $A_j$ の個数」で、上ではそれを `IntMap` から引いているので $O(\log N)$ かかっている。それを $O(1)$ にしたければ配列を使うしかないのだけど、$1 \leq A_i \leq 10^6$ サイズの配列張って大丈夫なん？

```haskell
import Data.Array.Unboxed

abc356e :: Int -> [Int] -> Int
abc356e n as =
  sum [ m * accA ! c
      | (k, m) <- assocs cntA, m > 0
      , c <- [k, k+k .. amax]
      ] -
  sum [ div (m * succ m) 2 | m <- elems cntA]
  where
    cntA, accA :: UArray Int Int
    cntA = accumArray (+) 0 (1, amax) [(a,1) | a <- as]
    accA = listArray (1, amax) $ scanl' (-) n $ elems cntA
    amax = maximum as
```

元のコードの `IntMap` を `UArray` に変えただけ。
結果：[AC, 362ms, 45MB](https://atcoder.jp/contests/abc356/submissions/54234503)

UnboxedでないArrayと`scanr`ではTLEした。

|Array\scan| L' | R1 |
|:-:|:-:|:-:|
|Unboxed|362ms|536ms|
|Boxed|952ms|TLE|

# F - Distance Component Size Query

[問題 ABC356F](https://atcoder.jp/contests/abc356/tasks/abc356_f)

シグネチャを決める。

```haskell
abc356f :: Int      -- Q
        -> Int      -- K
        -> [[Int]]  -- query_i
        -> Int      -- 答え
```

皆さんはきっと、座標圧縮してセグメント木なんだろうな、と思いつつ、`IntMap` と `Set` で正面突破を試みる。

- 集合 S の現在の内容を `s :: Set Int` で保持する（`IntSet` でないのがミソ）
- 距離 K 以下で連結している区間を、下端をキー、上端を値とする `im :: IntMap Int` で保持する

クエリ2に対して、このとき x は S にあることが保証されているので、`lookupLE x im` で x を含む区間の両端を取り出す。`Set.split` を用いて `s` の下端から上端までの部分集合を取り出して、その要素数を求めたら答え。
ここで、`Set.size` は $O(\log N)$ だが、`IntSet.size` は $O(N)$ なのであえて `Set` を使う。

クエリ1に対して x を挿入するときは、`im` で下にある区間の上端と、上にある区間の下端を調べる。これらが距離 K 以下なら接続する。下にある区間に含まれているような場合に注意。
どちらにも届かない場合、x だけからなる区間を追加する。

クエリ1に対して x を削除するときは、x が属する区間の両端を調べる。
xがこの区間の端にある要素かどうかで、区間を縮めるか、分断するか、何もしないか、抹消するかで更新する。

## 結果

$K = 0$のとき、連結成分の個数は調べるまでもなく常に1である。

```haskell
import qualified Data.Set as S
import qualified Data.IntMap as IM

abc356f :: Int -> Int -> [[Int]] -> [Int]
abc356f _q 0 qs = [1 | 2:_ <- qs]  -- 思考停止で
abc356f _q k qs = loop k S.empty IM.empty qs

loop :: Int -> S.Set Int -> IM.IntMap Int -> [[Int]] -> [Int]
loop _ _ _ [] = []
loop k s im ((2:x:_):qs) = ans : loop k s im qs -- クエリ2
  where
    Just (l,r) = IM.lookupLE x im
    ans = S.size $ fst $ S.split (succ r) $ snd $ S.split (pred l) s
loop k s im ((1:x:_):qs)
  | S.member x s = loop k s1 im1 qs -- x を除去
  where
    s1 = S.delete x s  -- x はあるので除く
    Just (y,z) = IM.lookupLE x im -- xは必ずどこかに属している
    Just l = S.lookupLT x s
    Just r = S.lookupGT x s
    im1 = case (x == y, x == z) of
      (True, True)  -> IM.delete x im -- x単独なら、それを除く
      (True, _   )  -> IM.insert r z $ IM.delete x im -- xが下端なら、一つ上rに肩代わりさせる 単独でないのでrは仲間
      (_   , True)  -> IM.insert y l im -- xが上端なら、一つ下まで切り詰める 単独でないのでlは仲間
      _ | r - l > k -> IM.insert r z $ IM.insert y l im -- 中間で、遠いなら切り離す
        | otherwise -> im                               -- まだ近いなら変化なし
loop k s im ((1:x:_):qs) = loop k s2 im2 qs -- x を追加
  where
    s2 = S.insert x s  -- x はないので入れる
    im2 = case (IM.lookupLE x im, IM.lookupGE x im) of -- 上下の区間が
      (Just (y,z), Just (p, q)) | z < x, x - z <= k, p - x <= k -> IM.delete p $ IM.insert y q im -- 距離k以下で並んでいるなら繋いでひとつに
      (Just (y,z), _) | z < x, x - z <= k -> IM.insert y x im -- 下の区間の上端をxまで延長
      (_, Just (p,q)) | p - x <= k -> IM.delete p $ IM.insert x q im -- 上の区間の下端をxまで延長
      (Just (y,z), _) | x < z -> im  -- 初めから区間に含まれているので何もしない
      _ -> IM.insert x x im          -- 新規のぼっち区間を追加
```

結果：[AC, 272ms, 81MB](https://atcoder.jp/contests/abc356/submissions/54211538) は自分でも予想外。
参考:[IntSet版](https://atcoder.jp/contests/abc356/submissions/54225940) は確かにTLEする。

公式方面は、「二分探索のあるセグメント木に、テクニカルな値と演算と探索を付ける」というアプローチで、その辺りの発想がまだ自分になくてつらい。

# G - Freestyle

[フレンズさんいわく](https://x.com/kyopro_friends/status/1796902811814559811)
> アライグマ「G問題は、凸包と直線の交点を求める問題になるのだ！」

だそうだけど、C/Dの直線より下ならいいので、交点に限らず、より右に突き出た凸包の端点があればそっちの方がいい、ということもありうるような？
示されたC++実装例を読み解くのも辛いので、またいずれ。