ABC318 A～F をHaskellで

- D : ビットDP
- E : DP, 累積和
- F : 解説が三者三様で、どのアプローチも興味深い。累積和による積分など。

# A - Full Moon

<!-- 僕は神山満月ちゃん！ -->

[問題 ABC318A](https://atcoder.jp/contests/abc318/tasks/abc318_a)

シグネチャを決める。

```haskell
abc318a :: Int  -- N
        -> Int  -- M
        -> Int  -- P
        -> Int  -- 答え
```

最初の満月までの$M$日を最初に捨てる。ここで一度は満月を見る。
（例2のように最初の満月より前に期間が終わる場合はここで除外する。）
残りの期間を$P$日ずつに区切ると、区間の最終日で満月になるので、普通に整数除算で答えが得られる。

## 結果

```haskell
abc318a n m p
  | n < m     = 0
  | otherwise = succ $ div (n - m) p
```

# B - Overlapping sheets

[問題 ABC318B](https://atcoder.jp/contests/abc318/tasks/abc318_b)

シグネチャを決める。$A_i,B_i,C_i,D_i$は手抜きする。

```haskell
abc318b :: Int      -- N
        -> [[Int]]  -- Ai,Bi,Ci,Di
        -> Int      -- 答え
```

$100 \times 100$マスを100枚なので、力任せに塗って $10^6$ の計算で解決する。

## 結果

```haskell
import Data.Array

abc318b :: Int -> [[Int]] -> Int
abc318b n abcds = length $ filter id $ elems arr
  where
    arr = accumArray (flip const) False ((0,0),(99,99))
          [ ((i,j), True)
          | a:b:c:d:_ <- abcds
          , i <- [a .. pred b]
          , j <- [c .. pred d]]
```

# C - Blue Spring

[問題 ABC318C](https://atcoder.jp/contests/abc318/tasks/abc318_c)

シグネチャを決める。

```haskell
abc318c :: Int    -- N
        -> Int    -- D
        -> Int    -- P
        -> [Int]  -- Fi
        -> Int    -- 答え
```

普通料金だけで旅行すると合計 $\sum F_i$ かかる。
一日周遊パスを$D$枚セットで買ったならば、$F_i$ の金額の高い方から $D$ 日選んで使うことにするべきである。
買ってしまったならば、パスの一日平均価格を $F_i$ が下回っても、パスを使えば $F_i$ の支出は必要ないので、パスを余らせる理由はない。

つまり、$F_i$ の高い方から $D$ 日ごとに区切った費用の総和をそれぞれ求め、それが $P$ を超えるセットに対してはパスを買うべきで、残りは普通料金を支払えばよい。

## 結果

```haskell
import Data.List

abc318c :: Int -> Int -> Int -> [Int] -> Int
abc318c n d p fs =
    sum $                     -- 4.合計
    map (min p . sum) $       -- 3.総和をとり、Pでクランプ
    chunksOf d $              -- 2.D日ごとにまとめて
    sortBy (flip compare) fs  -- 1.大きい順

chunksOf :: [a] -> [[a]]
chunksOf _ [] = []
chunksOf n xs = as : chunksOf n bs
  where
    (as,bs) = splitAt n xs
```

このやり方は[アライさんの説明](https://twitter.com/kyopro_friends/status/1697968610193617277)と同じ。

[公式解説](https://atcoder.jp/contests/abc318/editorial/7074)は話をややこしくしすぎでは…

# D - General Weighted Max Matching

[問題 ABC318D](https://atcoder.jp/contests/abc318/tasks/abc318_d)

シグネチャを決める。

```haskell
abc318d :: Int     -- N
        -> [[Int]] -- Dij
        -> Int     -- 答え
```

$N \leq 16$ がヒントで、使用済みのノード集合をビット表現して、それらのノードをちょうど使って作れる最大スコアを記録するDPを行う。
`popCount` が偶数になる要素しか使われないけれど、ここは富豪的に行きましょう。

使うノードが2個のとき、それらを結ぶ辺の重みそのものがスコア。

配るDPでは、あるノード集合について、もう一辺追加したスコアを、広がったノード集合のスコアの候補とする。それらの最大値をとる。

集めるDPでは、あるノード集合のスコアは、そこに含まれる一辺を引いて、その辺の重みと、残りのノード集合のスコアの和の最大値をとる。

## 結果

集めるDPを実装する。

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

abc318d :: Int -> [[Int]] -> Int
abc318d n dss = maximum $ elems score
  where
    ub = bit n - 1
    b2s = [b | b <- [3 .. ub], 2 == popCount b]
    score = listArray (3, ub) $ map f [3 .. ub]
    f x
      | pCx == 2 = (dss !! a) !! (pred (leastBit $ clearBit x a) - a)
      | even pCx = maximum
                   [ score ! y + score ! z
                   | y <- takeWhile (x >) b2s
                   , x .|. y == x
                   , let z = xor x y]
      | otherwise = -1
      where
        pCx = popCount x
        a = leastBit x

-- 1である最下位ビットの番号を求める
leastBit :: Int -> Int
leastBit x = pred $ popCount $ xor x $ pred x
```

## アライさんのアドバイス

> [ちょっと工夫するとO(N 1.619^N)になるのだ！](https://twitter.com/kyopro_friends/status/1697969207735177403)

だそうで。計算量の数字はよくわからないけど、実装がどうなるかは確認しよう。

頂点は必ず使用されるので、使用中の$k$個の頂点から任意に2つ選ぶ（$_k C_2$通り）代わりに、片方は番号が最小の頂点を決め打ちで選べば十分（$k - 1$通り）ということで、そうしてみる。

頂点が奇数の場合については、のけ者を総当たりで探すことになるが、計算をやり直さなくても、DP配列に答えは入っている。

```haskell
abc318d :: Int -> [[Int]] -> Int
abc318d n dss
  | even n = score ! ub
  | True   = maximum [score ! clearBit ub i | i <- [0..pred n]]
  where
    ub = bit n - 1
    score = listArray (3, ub) $ map f [3 .. ub]
    f x
      | pCx == 2 = (dss !! a) !! (pred (leastBit x1) - a)
      | otherwise = maximum
        [ score ! (bit a .|. bit b) + score ! x2
        | b <- [0 .. pred n], testBit x1 b
        , let x2 = clearBit x1 b
        ]
      where
        pCx = popCount x
        a = leastBit x
        x1 = clearBit x a
```

配列 `score` の1が奇数個な添え字の要素はおかしな内容だが、遅延評価によりノータッチで終わるため問題にならない。

タイムは[7ms](https://atcoder.jp/contests/abc318/submissions/45992940)でした。

## DFSするだけの解

[フェネックさんの指摘](https://twitter.com/kyopro_friends/status/1697969529392095467)

> フェネック「今回は辺が辞書順で与えられるから、辺のリストに関してDFSするだけでも間に合うよ。計算量はよくわかんないけどねー」

を確認してみる。

使うべきノード番号のリストから、先頭のものを片側に選び、もう片方を総当たりで選び、ノードがなくなるまで再帰する、深さ優先探索を行う。
ただし、ノードが奇数個のとき、仲間はずれにするノードを総当たりで$N$とおり調べる。

```haskell
import Data.Array
import Data.List

abc318d :: Int -> [[Int]] -> Int
abc318d n dss = maximum $ concatMap solve nodes
  where
    dA = listArray (1,pred n) [listArray (i,n) ds | (i,ds) <- zip [2..] dss]
    nodes = if even n then [[1..n]] else [delete i [1..n] | i <- [1..n]]
    solve vs = dfs [(0,vs)]
    dfs [] = []
    dfs ((score,v:vs):svs) = dfs $ [(score + dA ! v ! w, delete w vs) | w <- vs] ++ svs
    dfs ((score,[]):svs) = score : dfs svs
```

確かに間に合った。

# E - Sandwiches

[問題 ABC318E](https://atcoder.jp/contests/abc318/tasks/abc318_e)

シグネチャを決める。

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

$A_i$を$A_j$より手前と、$A_j$とそれ以降に分割する。
両側についてそれぞれ、ある値が何個あるかを数えた個数の表$cntL, cntR$があるとする。
また、同じ数ごとに、この個数の積をとったものの和$sop$ (sum of products) $sop = \sum_{x \in \{A_i\}} (cntL[x] \cdot cntR[x])$ もわかっているとする。

右側の先頭$A_j$に関して、数えるべき組の数は、$sop$から$A_j$の要素を除いた値なので $sop - cntL[A_j] \cdot cntR[A_j]$ となる。

分割を一つ右にずらした状態に対する$cntL,cntR$は、$A_j$の値を1増減させればよい。また$sop$は
$sop - cntL[A_j] \cdot cntR[A_j] + (cntL[A_j] + 1)(cntR[A_j] - 1) = sop + cntL[A_j] - cntR[A_j] - 1$となる。

$m = 0$のときの$cntL$の初期値はオール0、$cntR$の初期値は$A_i$全てのカウント、$sop = 0$である。

## 結果

```haskell
import qualified Data.IntMap as IM

abc318e :: Int -> [Int] -> Int
abc318e n as = sum cnts
  where
    aR0 = IM.fromListWith (+) [(a,1) | a <- as]
    (_, cnts) = mapAccumL step (IM.empty, 0, aR0) as
    step (aL, sop, aR) aj = ((aL1, sop2, aR1), sop1)
      where
        cL = IM.findWithDefault 0 aj aL
        cR = IM.findWithDefault 0 aj aR
        sop1 = sop - cL * cR
        sop2 = sop + cR - cL - 1
        aL1 = IM.insertWith (+) aj 1 aL
        aR1 = IM.insertWith (+) aj (- 1) aR
```

# F - Octopus

[問題 ABC318F](https://atcoder.jp/contests/abc318/tasks/abc318_f)

シグネチャを決める。

```haskell
abc318f :: Int    -- N
        -> [Int]  -- Xi
        -> [Int]  -- Li
        -> Int    -- 答え
```

わからなくて解説を見た。

## 公式解説のやり方

[公式解説](https://atcoder.jp/contests/abc318/editorial/7075) 長い。  
ようは、

1.頭をある位置 $q$ に置いたときに足が全て届くかは、足と宝の数が同じなので、整列して、対応するものどうしでそれぞれ足が届いていればいい。
`IntSet`を使うまでもないので`List`で：

```haskell
isOK q = all $ zipWith (>=) ls $ sort [abs (x - q) | x <- xs]
```

2.謎の位置集合 $Q = \\{ X_i + L_j ∣ 1 \leq i,j \leq N \\} \cup \\{ X_i - L_j - 1 ∣ 1 \leq i,j \leq N \\}$ の要素を
$Q = Q_1, \dots, Q_M$ とすると、

```haskell
qs = map head $ group $ sort [q | x <- xs, l <- ls, q <- [x + l, pred x- l]]
```

3.$Q_k$ の位置で足が届くなら、$Q_{k-1} + 1 \leq q \leq Q_k$ の区間のどこでも足が届き、また足が届くのはこの範囲に限られる。

```haskell
abc318f n xs ls = sum [q2 - q1 | (q1,q2) <- zip qs (tail qs), isOK q2]
```

[3行で書けた。](https://atcoder.jp/contests/abc318/submissions/46041270)

## 別解

[より高速な解法 by carrot46](https://atcoder.jp/contests/abc318/editorial/7091)

考え方は上より突飛だが、何がどうなっているのかは理解できた。

1. いずれかの宝 $Xi$ に対して、一番短い足 $L_1$ が届く頭の位置の範囲は $S_1 = \bigcup_i \\; [X_i - L_1, X_i + L_1]$
2. いずれかの宝 $Xi$ に対して、短い方から2番目の足 $L_2$ で届く宝が2つ以上ある範囲とは、区間 $[X_i - L_2, X_i + L_2]$ が2つ以上重なっている位置。これを $S_2$ とする。
3. $S_1 \cap S_2$ とは、$L_1$と$L_2$で2つの宝を掴むことができる位置。つまり、$L_1$が届く宝を掴み、$L_2$は届く宝が2つあるので、残った方を掴むことができる。
4. この論理を繰り返し、$S_N$までの全ての共通部分が、問題の要求する位置。

それぞれの区間$S_i$は、左端でアップ、右端でダウンのアップダウンを累積和で積分し、高さ$i$以上の範囲として取り出せる。
区間を始点と終点の対（終点は含まず）で表すとして、

```haskell
integlGE :: Int         -- i : 必要な重なり枚数
         -> [(Int,Int)] -- lrs : 区間列
         -> [(Int,Int)] -- 出力 : 重なりがi以上の区間列
integlGE i lrs =
    loop $
    scanl (\(_,v) (x,d) -> (x, v + d)) (minBound,0) $
    IM.assocs $
    IM.fromListWith (+) $
    [p | (l,r) <- lrs, p <- [(l,1),(r,-1)]]
  where
    loop xvs
      | null xvs1 = []
      | otherwise = (fst $ head xvs1, fst $ head xvs2) : loop xvs2
      where
        xvs1 = dropWhile ((i >)  . snd) xvs
        xvs2 = dropWhile ((i <=) . snd) xvs1
```

全ての $i$ に関する区間の共通部分は、それらの重なり$N$（以上）の区間である。

```haskell
abc318f n xs ls =
    sum $ map (uncurry subtract) $     -- 区間の格子点の個数
    integlGE n $ concat $              -- それらが N 重なる区間
    [ integlGE i lrs                   -- 1≦i≦N についてi以上重なる区間
    | (i, li) <- zip [1..] ls
    , let lrs = [(x - li, succ x + li) | x <- xs]
    ]
```

[11msで動いた。](https://atcoder.jp/contests/abc318/submissions/46041916)

## アライさんの方法

[フレンズさんの解説](https://twitter.com/kyopro_friends/status/1697970987005096386)

まず、どこかに頭を置くと、宝の近い順が定まり、例によって貪欲にどの足を割り当てるかが定まるから、そのように宝$X_i$と足$L_j$の対応が一つ決まっているとき、その対応で、頭をおける場所$Q$の範囲は、この対応について$X_i - L_j \leq Q \leq X_i + L_j$で、$N$個の区間の共通部分が実際に頭をおける場所の範囲。

なお、この頭と足の対応は、$N!$通りもあるわけではない。
任意の宝$X_i$と$X_j$の中間点$M = (X_i + X_j)/2$では、その両者との距離が等しい。
そこから左右にずれると、お宝の遠い順序が$X_i$と$X_j$について逆転する。
なので、中間点を小さい順に$M_1,\dots,M_K$とすると、これらで数直線を区切った分割$K+1$個について、その辺りから見たときの順序について考えればよい。

$X_1$より左に頭を置くと、近い順は添え字の順序そのままになる。
$X_i$と$X_j$の中間点を超えるとき、それらが対応付いていた足を互いに交換することになる。
足$X_i$に対応づけられている足の長さ$L_j$を、少し重いが$N \leq 200$なので我慢して、配列の更新で実装する。

ただし、中間点が格子点にならずに丸められたものと、格子点に乗った中間点とをぞんざいに重ねてしまうと、足の入れ替え順序が狂うので、対策として座標を2倍して計算する。

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

abc318f :: Int -> [Int] -> [Int] -> Int
abc318f n xs ls =
    sum $ map (uncurry subtract) $ unionspans $ -- 重複部分を重ねてから位置を数える
    sort $ filter (uncurry (<)) $  -- 空虚な区間を除去して整列させてから
    map single $
    scanl step i2l0 $
    IM.elems $ IM.fromListWith (++)
    [ (div (x + y) 2, [(i,j)])                      -- この中間点を超えるとき Xi と Xj で L を交換する
    | (i,x):jys <- tails (zip [1..] $ map (2 *) xs) -- Xiを2倍しておく
    , (j,y) <- jys]
  where
    i2l0 = listArray (1,n) ls
-- 一つの対応付けについて、頭の置ける区間を求める
    single i2l = foldl1 intersectspan
                 [(x - l, succ x + l) | (x, l) <- zip xs $ elems i2l]
-- 中間点を超えるときの足の入れ替え処理
    step i2l ijs = i2l // [p | (i,j) <- ijs, p <- [(i, i2l ! j), (j, i2l ! i)]]

-- 二つの区間の共通部分、空虚になっても気にしない
intersectspan :: (Int,Int) -> (Int,Int) -> (Int,Int)
intersectspan (a,b) (c,d) = (max a c, min b d)

-- ソート済みの区間について、重なりを統合する
unionspans :: [(Int,Int)] -> [(Int,Int)]
unionspans [] = []
unionspans [p] = [p]
unionspans ((a,b):(c,d):abs)
  | b < c = (a,b) : unionspans ((c,d):abs)
  | otherwise = unionspans ((a, max b d):abs) -- かかっているなら繋ぐ
```

[結果。](https://atcoder.jp/contests/abc318/submissions/46044252)
[格子点でない中間点がズレるバグ版](https://atcoder.jp/contests/abc318/submissions/46044181)をCompanionsにかけると、何やら先駆者が見つかったのだけど、彼らがどう直したのかはさっぱりわからなかった。