ABC351 A～F をHaskellで

# A - The bottom of the ninth

[問題 ABC351A](https://atcoder.jp/contests/abc351/tasks/abc351_a)

シグネチャを決める。

```haskell
abc351a :: [Int] -- Ai
        -> [Int] -- Bi
        -> Int   -- 答え
abc351a as bs = sum as - sum bs + 1
```

> ここで、9 回表の終了時点でチーム高橋の得点はチーム青木の得点以上です。

と保証されているので、コールドゲームの心配はしなくてよかった。

# B - Spot the Difference

[問題 ABC351B](https://atcoder.jp/contests/abc351/tasks/abc351_b)

シグネチャを決める。

```haskell
abc351b :: Int        -- N
        -> [String]   -- Aij
        -> [String]   -- Bij
        -> (Int,Int)  -- 答え
```

解は唯一存在すると保証されているので、素直に内包表記で探して、最初に見つかったものを返せばよい。

## 結果

```haskell
abc351b _n ass bss = head
  [ (i,j)
  | (i, as, bs) <- zip3 [1..] ass bss
  , (j, a , b ) <- zip3 [1..] as  bs
  , a /= b
  ]
```

# C - Merge the balls

[問題 ABC351C](https://atcoder.jp/contests/abc351/tasks/abc351_c)

シグネチャを決める。

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

スタックに $A_i$ をpushしては、スタックの上2つの要素が等しい限り1増やしたものに取り替える、を繰り返し、最後に残った要素数を答える。

## 結果

```haskell
abc351c _n as = length $ foldl step [] as
  where
    step xs a = loop (a:xs)
    loop (x:y:xs) | x == y = loop (succ x:xs)
    loop xs = xs

-- さらにショートカットした解
abc351c _n as = length $ loop [] as
  where
    loop (x:y:xs) as | x == y = loop (succ x:xs) as
    loop xs (a:as) = loop (a:xs) as
    loop xs [] = xs
```

# D - Grid and Magnet

[問題 ABC351D](https://atcoder.jp/contests/abc351/tasks/abc351_d)

シグネチャを決める。

```haskell
abc351d :: Int      -- H
        -> Int      -- W
        -> [String] -- Si
        -> Int      -- 答え
```

磁石に隣接しているマスをBマスとする。ここからスタートすると、どこにも動けない。自由度1
磁石に隣接していないマスをCマスとする。Cマスどうしは、自由に行き来できる。
CマスからBマスへ進入することはできる。ただしそこで止まる。

基本方針として、PAINTで塗り広げたマスの個数を数える。
このとき、Bマスへは、塗り広げることはするが、そこから隣接マスにさらに染み出すことはしないようにする。
また例1の(2,2)のように、ひとつのBマスは、連結したCマスの島の異なる島と接している場合もある。このような場合も含めて全てを数えるために、一つの開始点から塗り広げるマス目とは別に、開始点として調査済みなC点をチェックするための別のマス目も管理する。

## 結果

```haskell
import Data.Array
import Data.Array.ST
import Control.Monad.ST

abc351d :: Int -> Int -> [String] -> Int
abc351d h w ss = runST ans
  where
    bnds = ((1,1),(h,w))
-- 上下左右にずれたマスを作る
    four i j = [(pred i,j)|1<i] ++ [(succ i,j)|i<h] ++
               [(i,pred j)|1<j] ++ [(i,succ j)|j<w]
-- 0 : 自由Cマス, 1 : 束縛Bマス, 2 : 磁石#マス
    fld = accumArray max 0 ((1,1),(h,w)) $ concat
      [ ((i,j), 2) : [(ij1, 1) | ij1 <- four i j]
      | (i, s) <- zip [1..] ss, (j, '#') <- zip [1..] s]
-- touched : 過去に調査済みなCマスの記録
-- visited : 今回の調査で踏んだC,Bマスのマーク
    ans = do
      touched <- newArray bnds False :: ST s (STUArray s (Int,Int) Bool)
      maximum <$> forM (range bnds) (\ij -> do
        td <- readArray touched ij
        case fld ! ij of
          _ | td -> return 0
          1 -> return 1
          2 -> return 0
          _ -> do
           visited <- newArray bnds False :: ST s (STUArray s (Int,Int) Bool)
           writeArray visited ij True
           writeArray touched ij True
           loop touched visited 1 [ij]
        )
-- 深さ優先探索でtouched,visitedを塗る
    loop _ _ cnt [] = return cnt
    loop touched visited cnt ((i,j):ijs) = do
      (cnt1,ijs1) <- foldM (\(cnt0,ijs0) ij1 -> do
        vd <- readArray visited ij1
        if vd then return (cnt0, ijs0) else do
          writeArray visited ij1 True
          case fld ! ij1 of
            1 -> return (succ cnt0, ijs0) -- 数えるけど広げない
            0 -> writeArray touched ij1 True >> return (succ cnt0, ij1:ijs0) -- 広げる
        ) (cnt,ijs) (four i j)
      loop touched visited cnt1 ijs1
```

# E - Jump Distance Sum

[問題 ABC351E](https://atcoder.jp/contests/abc351/tasks/abc351_e)

シグネチャを決める。

```haskell
abc351e :: Int      -- N
        -> [[Int]]  -- Xi, Yi
        -> Int      -- 答え
```

チェス盤で、色の違うマスにいるビショップ（角）は、互いに取れない。
ちゃんというと、ジャンプのたびに$X,Y$は同時に+1または-1されるので、$X$,$Y$の偶奇が一致するかどうか、または、$X+Y$の偶奇はジャンプによって変化しない。つまり、それが同一の場所にしか行けない。
そこでまず、ウサギを、$X+Y$の偶奇によって2群に分けて考える。これで、$dist()$が0になる場合を気にせずに済む。

聞かれているジャンプの回数は、ようは、ナナメに引いた辺の長さ $\sqrt{2}$ 倍のマス目におけるマンハッタン距離である。なので、座標を45°回転させ、$1/\sqrt{2}$倍に縮小した座標系に投影して、このマンハッタン距離を数える。
難しいことを言っているように見えるが、$(X', Y') = (\frac{X+Y}{2},\frac{X-Y}{2})$ で考えるということである。

マンハッタン距離とは、座標成分ごとの差（の絶対値）の和で、これを真面目に計算するとやはり総当たりで計算量は $O(N^2)$ になる。
しかしここで、どの順に計算しても、総当たりにさえなっていればいいので、X軸とY軸を別々に計算しても、そのときの組みあわせの作り方の順序を入れ替えても、結果は同じであると気づく。

降順の数列 $A_i$ について、全ての組みあわせの差（の絶対値） $D = \sum_{1 \leq i<j \leq N} (A_i - A_j)$ を求めることを考える。
$D = \sum_{1 \leq j \leq N} \big \\{ \sum_{1 \leq i < j} (A_i - A_j) \big \\}$
ここで$D_j = \sum_{1 \leq i < j} (A_i - A_j)$ とおく。と $D = \sum_{1 \leq j \leq N} D_j$ である。
ある $k$ について $A_{k-1} - A_k = E$ とする。このとき
$D_k = \sum_{1 \leq i < k} (A_i - A_k) = \sum_{1 \leq i < k} (A_i - A_{k-1} + E) = D_{k-1} + kE$
となる。これで$D_1, \dots, D_N$ を高速に求めることができる。

## 結果

本来は `f` のところで `div (x + y) 2` と `div (x - y) 2` について計算するべきだが、最後の最後までこの2で割る計算を引き延ばした。

```haskell
abc351e :: Int -> [[Int]] -> Int
abc351e _n xys = div (f xys1 + f xys2) 2
  where
-- X+Yの偶奇で分割して考える
    (xys1,xys2) = partition (even . sum) xys

-- 回転させた座標成分ごとに考える
f :: [[Int]] -> Int
f xys = g [x + y | x:y:_ <- xys] +
        g [x - y | x:y:_ <- xys]

-- 降順にして、差のk倍を足すと次の項が得られる D_k = d_k-1 + k(A_k-1 - A_k)
g :: [Int] -> Int
g xs = sum $ scanl' (+) 0 $ zipWith (*) [1..] ds
  where
    xs1 = sortBy (flip compare) xs
    ds = zipWith (-) xs1 (tail xs1)
```

# F - Double Sum

[問題 ABC351F](https://atcoder.jp/contests/abc351/tasks/abc351_f)

シグネチャを決める。

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

$$\sum_{i=1}^{N-1} \sum_{j=i+1}^{N} \max(0, A_j - A_i)$$
それぞれの$i$について、$A_i$ を、それより後ろ $j > i$ の値 $A_j$ から引いた値の和を求める。
E問題と似たような二重のΣだが、今回は、負のときはReLU関数のように0で打ち切りする。

$i$ を後ろから巻き戻して考える。
ある $A_i$ について考えるとき、$A_j \\ (j > i)$ について、$A_i$ より大きいものだけを考えて、その総和 $S$ と個数 $k$ が得られれば、$S - kA_i$ が求めるものである。

$A_i$に降順に背番号を振り、この背番号ぶんのセグメント木を考える。
要素は、(和, 数の個数) というタプルで、演算は成分毎の和とする。
すると、次の手順で問題の答えが得られる。

- $i$ を$N$ から $1$ まで順に、
  - $A_i$ の背番号 $x$ について、セグメント木を区間 $(0,x)$ で問い合わせた結果 $(S, k)$ について、$T_i = S - kA_i$ が今回の分の項
  - セグメント木の要素 $x$ に $(A_i, 1)$ を足し込んで更新する
- $\sum T_i$ が解

区間$(0,x)$の問い合わせとはつまり、既出の$A_i$について$A_j$より大きいものだけについて、その総和と要素数になる。

## 結果

しかしデータ数が$4 \times 10^5$ と多くて、間に合わせるのは少し難儀した。

```haskell
import qualified Data.IntMap as IM
import qualified Data.IntSet as IS

import Control.Monad
import Control.Monad.ST

abc351f :: Int -> [Int] -> Int
abc351f n as = runST ans
  where
-- Aiの大きい順に背番号
    a2i = IM.fromSet (\k -> maybe 0 (succ . snd) $ IM.lookupGT k a2i) $ IS.fromList as
-- Aiの異なる要素の種類数
    m = succ $ snd $ IM.findMin a2i
-- 総和と個数の両方を足す演算
    add (a,b) (c,d) = (a+c, b+d)
-- 本体
    ans = do
      st <- makeSegTreeN add (0,0) m :: ST s (SegmentTree (ST s) (Int,Int))
      recur st as
-- リストの後ろから計算するループ
    recur _st [] = return 0
    recur st (a:as) = do
      acc <- recur st as
      let i = a2i IM.! a
      (v,k) <- querySegTree st 0 i
      modifySegTree st i (add (a, 1))
      return $! acc + v - k * a
```

全体は[こちら (1616ms, 140MB)](https://atcoder.jp/contests/abc351/submissions/52906621)

## すごい簡潔な方法

[ユーザ解説 by sounansya](https://atcoder.jp/contests/abc351/editorial/9897)が凄い。

```haskell
abc351f :: Int -> [Int] -> Int
abc351f n as = f [0..] (sort as) - f [n-1, n-2 ..] as
  where
    f xs ys = sum $ zipWith (*) xs ys
```

上で考えた苦労は何だったのか。

## その他の解説解

「ちょっとした別解 by evima」で「座標圧縮が不要」といっているが、要素を昇順に整列したその背番号は座標圧縮に他ならないのでは。
Pythonわからないので `for i, a in sorted(enumerate(A), key=lambda x: x[1]):` で何がどういう順序で動くのかわからんくて何とも言えないけど。

他ふたつの別解は、尺取法を利用している勘どころがよくわからない。

# G - Hash on Tree

降参。