ABC132をHaskellで

AtCoder Problems に D を recommend されて、他も解いて面白かったのでまとめておく。
特にFは公式解説がざっくりしすぎているし。

---

# A - Fifty-Fifty

[問題 ABC132A](https://atcoder.jp/contests/abc132/tasks/abc132_a)

シグネチャを決める。

```haskell
abc132a :: String  -- S
        -> Bool    -- 答え
```

何とでもなる。

## 公式解説のやり方1

「3通りに場合分けして考える」は間違ってないけど、計算が済んだことを蒸し返さないようにできる。

```haskell
abc132a [a,b,c,d]
  | a == b    = b /= c && c == d  -- aとbが等しいとき、cとdが等しく、abとcdが異なることが条件
                                  -- 以降、aとbは異なることは確定
  | a == c    = b == d            -- そしてaとcが等しいとき、あとはbとdが等しいことだけ調べれば十分
                                  -- 以降、aとcも異なることは確定
  | otherwise = a == d && b == c  -- 残るdがaと等しく、bとcが等しいことが最後の可能性
```

## 公式解説のやり方2、ユーザ解説

ソートすればAABBのパターンだけ確認すれば済む、それはそうだけど道具が大袈裟すぎないか。

```haskell
import Data.List

abc132a s = a == b && b /= c && c == d
  where
    [a,b,c,d] = sort s
```

## Haskellらしい？解法

aと一致するものを除いたら、残りは同じ2文字になるはず。

```haskell
abc132aa (c:cs) =
  case filter (c /=) cs of
    [x,y] -> x == y
    _     -> False
```

# B - Ordinary Number

[問題 ABC132B](https://atcoder.jp/contests/abc132/tasks/abc132_b)

シグネチャを決める。

```haskell
abc132b :: Int    -- n
        -> [Int]  -- pi
        -> Int    -- 答え
```

つまり、$p_{i-1} < p_i < p_{i+1}$ または $p_{i-1} > p_i > p_{i+1}$ となっているということになる。順列なので等しい値は現れない。

## 結果

```haskell
import Data.List

abc132b :: Int -> [Int] -> Int
abc132b _n xs = length $ filter id $ zipWith3 prop xs (tail xs) (drop 2 xs)
  where
    prop a b c = a < b && b < c || a > b && b > c
```

# C - Divide the Problems

[問題 ABC132C](https://atcoder.jp/contests/abc132/tasks/abc132_c)

シグネチャを決める。

```haskell
abc132c :: Int    -- N
        -> [Int]  -- di
        -> Int    -- 答え
```

整列した順で添え字を付け直したとして、$N = 2M$ として、前半と後半$M$個ずつに分けることになる。
$d_1 \leq d_2 \leq \dots \leq d_M \leq d_{M+1} \leq \dots \leq d_{M+M}$
$K$ は $(d_M, d_{M+1}]$ の任意の値にできる。

## 結果

```haskell
import Data.List

abc132c :: Int -> [Int] -> Int
abc132c n ds = dm1 - dm
  where
    dm : dm1 : _ = drop (pred $ div n 2) $ sort ds
```

# D - Blue and Red Balls

[問題 ABC132D](https://atcoder.jp/contests/abc132/tasks/abc132_d)

シグネチャを決める。

```haskell
abc132d :: Int  -- N
        -> Int  -- K
        -> Int  -- 答え
```

青いボールの列に$i-1$個の切れ目を入れて$i$群（それぞれの群は1つ以上の要素を持つ）に分け、その分け目に赤いボールを1つ以上振り分ける。さらに、両端の2カ所にも赤いボールを置いてもよい。

高校数学では「重複組み合わせ」と呼ぶらしい、見分けの付かないもの$N$個を、群の要素は0個でもよい$K$群に分けるやり方の個数は、$K-1$本の仕切りと$N$個の要素を適当に並べるやり方の場合の数になって、$\_{N+K-1}C_{K-1}$ となる。
群の要素は0ではいけないという変種を考えるには、あらかじめ$K$個を固定的に群に振り分け、残り$N-K$個を、0個ありで$K$群に分ければよいので、$\_{(N-K)+K-1}C_{K-1} = \_{N-1}C_{K-1}$ となる。

これを使うと、青いボール$K$個を0なしで$i$群に分ける方法 $\_{K-1} C_{i-1}$ 通りに、赤いボール$N-K$個のうち$i-1$個を確定の区切りに使い、残りを、両端含めて$i+1$群に0ありで分ける方法 $\_{N-K+1}C_{i}$ を乗じた数が答えになる。分割できる条件は、確定で配るボールが足りること $i-1 \leq N-K$ である。

## 結果

公式解説でもそれでいいと言っているので、$\_N C_K$ はパスカルの三角形で作ることにする。

```haskell
import Data.Array

abc132d :: Int -> Int -> [Int]
abc132d n k = map f [1 .. k]
  where
    comb = listArray (0,n) $ map combf [0 .. n]
    combf n = listArray (0,n) $ map (combff n) [0 .. n]
    combff n k
      | k == 0 || k == n = 1
      | otherwise = reg $ (combn1 ! pred k) + (combn1 ! k)
      where
        combn1 = comb ! pred n
    f i
      | pred i <= n - k = reg $ (comb ! pred k ! pred i) * (comb ! (succ n - k) ! i)
      | otherwise       = 0

modBase :: Int
modBase = 1_000_000_007
reg :: Int -> Int
reg x = mod x modBase
```

# E - Hopscotch Addict

[問題 ABC132E](https://atcoder.jp/contests/abc132/tasks/abc132_e)

シグネチャを決める。引数が多いので横着する。

```haskell
abc132e :: [Int]   -- N,M,S,T
        -> [[Int]] -- ui, vi
        -> Int     -- 答え
abc132e [n,m,s,t] uvs = ...
```

3の倍数の距離で到達できるかを調べることが求められている。
ひとつひとつの頂点を、スタート地点からの距離を3で割った余りが0,1,2で区別して、3倍の頂点があるとみなす。頂点 $u$ を $(u,0), (u, 1), (u, 2)$ に分身させる。
辺は、距離がそうなるように張り直す。つまり、本来の辺 $(u,v)$ を $((u,0),(v,1)), ((u,1),(v,2)), ((u,2),(v,0))$ の3辺に分身させる。
このグラフ上で $(s,0)$ から $(t,0)$ への距離が $d$ ならば答えは $d/3$ とわかる。

## 結果

上の形式的な定義を忠実になぞる。

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

abc132e :: [Int] -> [[Int]] -> Int
abc132e [n,m,s,t] uvs = bfs 0 (S.singleton start) [start] []
  where
    g = accumArray (flip (:)) [] (1,n) [(u, v) | u:v:_ <- uvs]
    start = (s,0)
    goal  = (t,0)
    bfs :: Int              -- 現在位置の距離
        -> S.Set (Int,Int)  -- 訪問済みの頂点集合
        -> [(Int,Int)]      -- 直前に訪問済みで、ここから辺を伸ばす頂点リスト
        -> [(Int,Int)]      -- 今回のターンで新たに訪問された頂点リスト
        -> Int              -- 答え、ゴールまでの距離
    bfs _nt _ [] [] = -1                                       -- 経路なし
    bfs cnt visited [] nexts = bfs (succ cnt) visited nexts [] -- BFSを一段進める
    bfs cnt visited (uk@(u,k):uks) nexts
      | uk == goal = div cnt 3                                 -- ゴールしたら距離/3が答え
      | otherwise = bfs cnt visited1 uks nexts1
      where
        j = mod (succ k) 3
        (nexts1, visited1) = foldl step (nexts, visited) (g ! u)
        step nv@(nexts0, visited0) v
          | S.member vj visited0 = nv       -- 重複しないようにこまめに検査
          | otherwise            = (vj:nexts0, S.insert vj visited0)
          where
            vj = (v,j)
```

結果は[AC, 332ms, 78MB](https://atcoder.jp/contests/abc132/submissions/51785135)

`step`ではこのようにこまめに検査しないと、同じステップで同一の頂点がリストに複数紛れ込み、[計算量が爆発する。](https://atcoder.jp/contests/abc132/submissions/51785046)

`Data.Ix` のようにして頂点を整数で表現し、訪問済み頂点集合を `Data.Vector.Unboxed.Mutable` で扱うよう高速化すると [71ms, 39MB](https://atcoder.jp/contests/abc132/submissions/51758886)で走る。

# F - Small Products

[問題 ABC132F](https://atcoder.jp/contests/abc132/tasks/abc132_f)

シグネチャを決める。

```haskell
abc132f :: Int  -- N
        -> Int  -- K
        -> Int  -- 答え
```

## 考える

### 普通のDPで数えてみる

長さ $i$ の数列で、末尾の数が $x$ になっているものの個数を $C[i, x]$ とする。
考えるべき値の範囲は $1 \leq x \leq N$ である。
初期値は $C[1, x] = 1$
$C[i+1,x]$ は $x * y \leq N$ を満たす範囲の $C[i,y]$ の総和なので $\displaystyle C[i+1, x] = \sum_{y = 1}^{\lfloor N/x \rfloor} C[i,y]$
配るDPでいうと、$C[i,y]$ の値は $1 \leq x \leq N/y$ の範囲の $C[i+1,x]$ に足し込まれる。
最終的な答えは $\displaystyle \sum_{x = 1}^N C[K,x]$ となる。

```haskell
abc132f n k =
  where
    c1 = listArray (1,n) $ replicate n 1
    ck = iterate step c1 !! pred k
    step ci = accumArray add 0 (1,n)
      [ (x, c)
      | (y, c) <- assocs ci  -- C[i,y] = c を
      , x <- [1 .. div n y]  -- C[i,1≦x≦N/y] に配る
      ]

modBase :: Int
modBase = 1_000_000_007
reg :: Int -> Int
reg x = mod x modBase
add :: Int -> Int -> Int
add x y = reg $ x + y
mul :: Int -> Int -> Int
mul x y = reg $ x * y
sub :: Int -> Int -> Int
sub x y = reg $ x - y
```

### 足し合わせの効率化

上の `step` は内包表記が二重ループになっているので $O(N^2)$ かかる。
配る範囲は常に $[1, N/y]$ となっていて、$y$ が大きい程1に近い、狭い範囲だけになる。
それぞれの $y$ について、$N/y$ 以下に $c$ を足し込む、というインパルスを累積することで、効率的にこの計算を実行できる。

```haskell
    step ci = cj
      where
        da = accumArray add 0 (1,n) [(div n y, c) | (x, c) <- assocs ci] -- インパルスの集計
        cj = listArray (1,n) $ scanr1 add $ elems da                     -- Nから1に向けて累積和
```

`da`, `cj` ともに $O(N)$ で済む。

### まばらな添え字を詰める

上の `da` を作る際に、$y$ から $x = \lfloor N / y \rfloor$ へ情報が流れる。
$x = N / y$ という双曲線のグラフを考えると、$1 \leq y \leq \sqrt{N}$ の範囲では、$x$ は急峻に変化し、$y$と$y+1$の行き先は全く異なる。そしてまばらで、情報を渡されない$x$も多い。
一方、後半の$\sqrt N \leq y \leq N$の範囲では、変化は急激に減速し、同じ $x$ に対していくつもの $y$ が情報を渡す。

特に、例えば $(N/2, N)$ の要素は、`da` では常に0で、`cj` では全員 `cj ! n` と同じ値をとる。これを別の要素としていちいち計算するのも勿体ない。

そこでまず、意識するべき $y$ の要素を考える。
$[1, \sqrt N]$ の範囲は全てを扱う。$(\sqrt N, N]$ については、出現するもののみ、つまり $\\{ \lfloor N / y \rfloor | 1 \leq y \leq \sqrt N \\}$ だけを考えることにする。
$N$が平方数でないとき、$S = \lfloor \sqrt N \rfloor$ として、その要素数は $M = 2S$ で、平方数のときは平方根で重複するので $M = 2S-1$ となる。

この、意識するべきそれぞれの値を $y_1, \dots, y_i, \dots, y_M$ と呼ぶことにする。
それぞれの数の背番号 $i$ を添え字とする配列 $A[i]$ の値は、元の配列の $(y_{i-1}, y_i]$ が一律にその値を持っている、と解釈する。
情報の流れは、添え字 $i$ が表す範囲 $y_{i-1} < y \leq y_i$ から添え字 $M - i + 1$ に、つまり後ろから $i$ 個めの要素に流れる。

`da` を作るには、添え字 $i$ が表す範囲の広さだけ、自分の値を倍増させて考える必要がある。
つまり係数 $c[i] = y_i - y_{i-1}$ を掛ける。

```haskell
    s = floor $ sqrt $ fromIntegral n                        -- ⌊√N⌋
    isSq = s * s == n                                        -- N は平方数か
    m = (if isSq then pred else id) s + s                    -- M
    cs = replicate s 1 ++ (if isSq then tail else id) (zipWith sub dnxs (s:dnxs))
      where
        dnxs = [div n x | x <- [s, pred s .. 1]]

    step ci = cj
      where
        da = accumArray add 0 (1,m) [(succ m - x, mul c k) | ((x,c), k) <- zip (assocs ci) cs]
        cj = listArray (1,m) $ scanr1 add $ elems da
```

最終結果も、係数 $c[i]$ を掛けつつ足し合わせる。
結果：[AC, 1386ms, 216MB](https://atcoder.jp/contests/abc132/submissions/51774693)

こういうのも「平方分割」の一種なのだろうか。