ABC348 A～F をHaskellで

# A - Penalty Kick

[問題 ABC348A](https://atcoder.jp/contests/abc348/tasks/abc348_a)

`oox` の繰り返しを $N$ 文字出力する。

```haskell
abc348a :: Int     -- N
        -> String  -- 答え
abc348a n = take n $ cycle "oox"
```

# B - Farthest Point

[問題 ABC348B](https://atcoder.jp/contests/abc348/tasks/abc348_b)

シグネチャを決める。$X_i, Y_i$ は横着する。

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

## 普通のやり方

総当たりで計算するだけ。$N \leq 100$ なので $O(N^2)$ も気にならない。
平方根は計算しないでいい。
ペアの最大値をとるとき、辞書順になるので、番号が最小のものが選ばれるように細工をする。

```haskell
abc348b _n xys =
  [ negate $ snd $ maximum              -- 4.距離最大、番号最小を探して、番号を取り出す
    [ ((xi - xj)^2 + (yi - yj)^2, - j)  -- 3.距離^2とマイナス番号を求めて
    | (xj:yj:_, j) <- zip xys [1..]]    -- 2.それぞれの点 (Xj,Yj) と番号 j について
  | xi:yi:_ <- xys]                     -- 1.それぞれの点 (Xi,Yi) について
```

## 無駄に凝ったやり方

$i$ 対 $j$ について計算した結果を $j$ 対 $i$ としても使うことで、計算量を半分にする。

```haskell
import Data.Array

abc348b :: Int -> [[Int]] -> [Int]
abc348b n xys =
    map (negate . snd) $ elems $
    accumArray max (0,0) (1,n)
    [ p
    | (i, xi:yi:_):ixys <- tails $ zip [1..] xys
    , (j, xj:yj:_) <- ixys
    , let d2 = (xi - xj)^2 + (yi - yj)^2
    , p <- [(i, (d2, - j)), (j, (d2, - i))]
    ]
```

> 相異なる2点の座標は異なります。

$(X_i,Y_i) = (X_j, Y_j)$ のとき、相異ならない点なので、これだと恒真なのでは…

# C - Colorful Beans

[問題 ABC348C](https://atcoder.jp/contests/abc348/tasks/abc348_c)

シグネチャを決める。

```haskell
abc348c :: Int      -- N
        -> [[Int]]  -- Ai,Ci
        -> Int      -- 答え
```

ある色を選んだときの最悪の可能性は、その色の最低のおいしさに当たること。
それが一番大きな色にすれば、最悪の場合のダメージを最小にできる。

色の種類が多いので、配列では張れない。

## 結果

```haskell
import qualified Data.IntMap as IM

abc348c :: Int -> [[Int]] -> Int
abc348c _n acs = maximum $ IM.elems $ IM.fromListWith min [(c,a) | a:c:_ <- acs]
```

# D - Medicines on Grid

[問題 ABC348D](https://atcoder.jp/contests/abc348/tasks/abc348_d)

シグネチャを決める。

```haskell
abc348d :: Int      -- H
        -> Int      -- W
        -> [String] -- Aij
        -> Int      -- N
        -> [[Int]]  -- Ri,Ci,Ei
        -> Bool     -- 答え
abc348d h w ass n rces = ...
```

引数が…引数が多い！<!-- 犯人達の事件簿 -->（やることも多い。）

## 考える

グリッドの各マスについて、移動可能な位置かどうかを読み取れる配列が必要になるだろうことは言うまでもない。

```haskell
import Data.Array

abc348d :: Int -> Int -> [String] -> Int -> [[Int]] -> Bool
abc348d h w ass n rces = ...
  where
    bnds = ((1,1),(h,w))
-- 通れるマスならTrue
    fld = listArray bnds [a /= '#' | as <- ass, a <- as]
```

`S`と`T`の位置を探し出すことも必要。`rces`と同じ形式で、エネルギー0として返すようにする。

```haskell
-- SとTの位置
    findPos c = head [[i,j,0] | (i,as) <- zip [1..] ass, (j,a) <- zip [1..] as, a == c]
    sxy = findPos 'S'
    gxy = findPos 'T'
```

薬の位置に到達してから、$E_i$までの距離で、次の薬か、またはゴールに到達する必要がある。
つまり、薬から次の薬またはゴールへの有向辺からなるグラフを考え、スタート（エネルギー0の薬とみなす）からゴールへの到達可能性を調べればよい。

元々の薬リストに、ゴールとスタートを擬似薬として追加し、番号を振る。

```haskell
-- S,Tの位置に威力0の薬を追加
    irces = zipWith (:) [1..] (gxy:sxy:rces)
```

`fld`に対してペイントを行って、それぞれの薬から到達できるマスを調べ上げる。終わったら、他の薬の位置を確認することで、到達できる薬の番号を調べ上げる。

すごく間に合わなそうな気がするので、ここはSTUArrayを使う。

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

-- それぞれの薬の位置からpaintして、他のどの薬に到達できるか調べると有向グラフができる
    es = [(i,j) | irce@(i:_) <- tail irces, j <- paint irce]

    paint (i:r:c:e:_) = runST $ do
      fld1 <- newArray bnds False :: ST s (STUArray s (Int,Int) Bool)
      writeArray fld1 (r,c) True
      paintloop fld1 e [] [(r,c)]
      foldM (\js (j:r:c:_) -> do
        v <- readArray fld1 (r,c)
        return $ if v && i /= j then j:js else js
        ) [] irces
    paintloop _ 0 [] _ = return () -- 薬0で配り終えたら次へは進まない
    paintloop fld1 e [] news = paintloop fld1 (pred e) news [] -- 薬を1減らして、次の周回へ
    paintloop fld1 e (rc@(r,c):rcs) news = do
      news1 <- foldM (\news0 rc1 -> do
        v <- readArray fld1 rc1
        if v || not (fld ! rc1) then return news0 else do -- ←(!!!)
          writeArray fld1 rc1 True
          return (rc1:news0)
        ) news rc1s
      paintloop fld1 e rcs news1
      where
        rc1s = [(succ r,c) | r < h] ++ [(pred r,c) | r > 1] ++
               [(r,succ c) | c < w] ++ [(r,pred c) | c > 1]
```

ここで、`paint`で作った`fld1`を`freeze`して返して、immutableな場所で`j`を確認するとかっこいいのだが、時間がギリギリになる。

現在の位置`(r,c)`から1マス移動した位置`rc1`が移動可能かどうかのチェックは、`rc1s`リストを作るときにやってしまう方がいい気がするが、これを `(!!!)` のタイミングまで引き延ばした方が実行時間を有意に節約できた。不思議。

これで`es`に、`Data.Graph`でグラフを作ることのできる有向辺リストが得られたので、グラフを作り、仮想薬番号2（スタート）から番号1（ゴール）に到達できるか調べれば終わり。

```haskell
import Data.Graph

abc348d h w ass n rces = path g 2 1
  where
-- グラフ
    g = buildG (1, n+2) es
```

# E - Minimize Sum of Distances

[問題 ABC348E](https://atcoder.jp/contests/abc348/tasks/abc348_e)

シグネチャを決める。

```haskell
abc348e :: Int      -- H
        -> [[Int]]  -- Ai,Bi
        -> [Int]    -- Ci
        -> Int      -- 答え
```

木の重心を求める。

最初は適当にどこか候補を決める。
そこを根$R$として、他の全ての頂点の重さ $C_i$ が、根までの経路をなす辺にかける荷重の和 $D_j$ を計算する。（距離は関係なく、ひっぱり荷重を足し合わせる。）
$f()$ をコストと呼ぶことにする。
$f(R)$自体はわからないが、辺にかかっている荷重と頂点の重さから、$R$と辺$e$で隣接する頂点$V$の$f(V)$は導ける。
$f(R)$の内容のうち、$V$以下の部分木のノードからの分は、$V$よりも $D_i$ だけ増えている。なので、$R$ から $V$ に移動すると、コストがまず $D_i$ だけ減る。
ただし辺$i$には逆向きに新たなひっぱり荷重がかかる。その値は、$R$の$i$以外全ての辺のひっぱり加重と$C_R$そのものである。これは、$R$から$V$に移動することで逆に増えるコストの分である。
$R$の辺全ての加重の総和を$W$とすると、$W - D_i + C_R$ が増加分である。
結局、$f(V) = f(R) + W + C_R - 2D_i$ となる。

$R$の隣接頂点で、差分$W + C_R - 2D_i$が負になり、その中で最も小さな頂点に移動する。（多分、負になるのはたかだか一カ所）
どの隣接頂点も差が正のとき、移動する先はなく終了する。
移動先 $V$ があるとき、辺の加重の和 $D_i = W + C_R - D_i$ の一点だけ修正し、以上の処理を繰り返す。

重心が確定したら、$D_i$ の総和がそこを根とするコストの値になる。

## 結果

`ew`を immutable array に入れたままでは間に合わないが、mutable array に入れて命令型でコードを書くのもダルいので、IntMap で代用した。
`cands`の計算は、辺$i$以外の$r$の全ての辺の重みの総和－辺$i$の重み＝$r$の全ての辺の重みの総和－2×辺$i$の重み、で総和を一度だけ計算している。
`snd`に続きの計算を入れて、遅延評価で一つだけ実行する。

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

abc348e :: Int -> [[Int]] -> [Int] -> Int
abc348e n abs cs = sum $ IM.elems ewBest
  where
-- Ci
    c = listArray (1,n) cs
-- いつものグラフ
    g = accumArray (flip (:)) [] (1,n)
        [p | (i, a:b:_) <- zip [1..] abs, p <- [(a,(b,i)),(b,(a,i))]]
-- 1を根として、その他の頂点から親への辺
    pa = array (2,n) $ tail $ recur 0 1 0 []
    recur p v i rest = (v, i) : foldr ($) rest [recur v c j | (c,j) <- g ! v, c /= p]
-- 1を根として、各辺のひっぱり荷重
    ew1 = array (1, pred n)
          [ (i, c ! v + sum [ew1 ! j | (_,j) <- g ! v, j /= i])
          | (v, i) <- assocs pa]
-- ew1をIntMapに写す
    ew1im = IM.fromDistinctAscList $ assocs ew1
-- 最適な根でのewを移動して発見する
    ewBest = move 1 ew1im
    move r ew
      | null cands = ew
      | otherwise  = head cands -- deltaが負になる候補はたかだか一つ
      where
        base = c ! r + sum [ew IM.! i | (_, i) <- g ! r]
        cands = [ move v (IM.insert i (base - ew IM.! i) ew)
                | (v, i) <- g ! r
                , base - 2 * ew IM.! i < 0] -- delta
```

# F - Oddly Similar

[問題 ABC348F](https://atcoder.jp/contests/abc348/tasks/abc348_f)

シグネチャを決める。

```haskell
abc348f :: Int      -- N
        -> Int      -- M
        -> [[Int]]  -- Aij
        -> Int      -- 答え
```

数列が$N$本あるので、相互に比較する組みあわせが $N(N-1)/2$ とおり。
比較する要素数が $M$ 個なので、計算量は $O(N^2M)$ にしかならず、$8 \times 10^9$ で間に合わない。
$A_{i,j}$ の変動が小さいのがヒントだろうけど、バケツで等しい物同士により分けた後、結局どうするのかわからず解説を見た。

ユーザ解説 by bayashiko「配列の要素の並び順とキャッシュを揃えるよう配慮すればC++なら愚直な計算で間に合う」
（ifの回避、は `cnt[j][k]^=(A[i][j]==A[i][k])` のことだろうけど、`A[i][j]==A[i][k]`はmipsならset on eq命令あっても（これも疑似命令）x86だと分岐命令使う貴ガス。はるか昔にi8088アセンブリプログラミングしたから僕は詳しいんだ。

公式解説 by MtSaka「$j$に対して$A_{i,k}$が等しい$i$のリストをC++のbitsetで表し、反転をxorで実現すると間に合う。」
C++には任意長のビットフィールドがあるの？まじ？ズルくない？
ムカついたので改善しておきました。[⇒ 542ms](https://atcoder.jp/contests/abc348/submissions/52712161)
解説のコードでは、
- 全てのAjについて、Aijが等しいものどうしのビットマップを作る、フェーズと、
- Aijが等しいもののビットマップをjの累積ビットマップにxorで足し込む、フェーズ

が分けてあるから、(i,j)と(j,i)で倍数えてしまうし、Mが奇数のときは(i,i)まで数えてしまう。
Aijと等しいもののビットマップを先に累積して、次にjをビットマップに追加、とやれば、
jより小さい番号のものだけ数えるから、補正処理もいらなくなっている。

Python3も整数は最初から多倍長で、ビット演算もそのまま使えるから同じことできるんだよね。

よく考えたらHaskellも
```haskell
instance Bits Integer
```
でした。じゃあ同じことすればいいのね。
`IntSet`の方がずっと上品だけど、`xor`ができない。

## 結果

フェーズを分ける、公式解説のやり方をなぞる形になった。

```haskell
import Data.Array
import Data.Bits

abc348f :: Int -> Int -> [[Int]] -> Int
abc348f n m ass
  | even m    = div acc 2       -- Mが偶数なら、(i,i)が等しい、はキャンセルされている
  | otherwise = div (acc - n) 2 -- Mが奇数だと補正が必要
  where
    acc = sum $ map popCount $ elems $        -- 5. 全部済んだら、1の個数を数える
          accumArray xor (0 :: Integer) (1,n) -- 4. xor して、奇数回等しいjのビットだけ1にする
      [ p
      | as <- transpose ass                   -- 1. Aikの縦一列ずつ処理する
      , let bm = accumArray (.|.) 0 (1,999) $ -- 2. Aik = xのとき、bm[x]のビットiを立てる
                 zip as $ map bit [0..]
      , p <- zip [1..] $ map (bm !) as        -- 3. i に対して、Aik と等しい値な Ajk のjのbitsetを
      ]
```

改善版のアプローチをSTモナドで実装しても間に合わなかった。なぜ…

# G - Max (Sum - Max)

[フレンズさん](https://twitter.com/kyopro_friends/status/1776611958076166505)いわく
> アライグマ「G問題はBでソートして分割統治法で考えると、max-plus convolutionになって解けるのだ！」

[A,B,C,Fの作者=サン(?)](https://twitter.com/mt_saka/status/1776606916179030319)いわく
> G:分割統治と凸max-plus-convolution(たぶん初出)

max-plus convolutionでググると[ABC218Hの公式解説 by kyopro_friends](https://atcoder.jp/contests/abc218/editorial/2602)（のなぜか英語版）が出てくる。

…ちょっと急用を思い出したのでここで失礼します。