ABC323 A～F をHaskellで

- E : 配るDP

----

# A - Weak Beats

[問題 ABC323A](https://atcoder.jp/contests/abc323/tasks/abc323_a)

シグネチャを決める。

```haskell
abc323a :: String -- S
        -> Bool   -- 答え
abc323a (_:'0':s) = abc323a s
abc323a ""        = True
abc323a _         = False
```

# B - Round-Robin Tournament

[問題 ABC323B](https://atcoder.jp/contests/abc323/tasks/abc323_b)

シグネチャを決める。

```haskell
abc323b :: Int      -- N
        -> [String] -- Si
        -> [Int]    -- 答え
```

各プレイヤーの勝利回数を数え、その降順、ただし同順の場合は番号の昇順、という順序でソートし、番号を抜き出す。
そのような比較関数を作って `sortBy` するのが王道だが、符号を反転させるのが手っ取り早い。

## 結果

```haskell
import Data.List

abc323b :: Int -> [String] -> [Int]
abc323b _n ss = map snd $ sort [(- c, i) | (s,i) <- zip ss [1..], let c = length $ filter ('o'==) s]
```

## バケツソートによる方法

[ユーザ解説 by shobonvip](https://atcoder.jp/contests/abc323/editorial/7366)に、`o`の個数でバケツソートすれば $O(N)$でできるという指摘があったのでやっておく。

```haskell
import Data.Array

abc323b :: Int -> [String] -> [Int]
abc323b n ss =
    concatMap reverse $ elems $
    accumArray (flip (:)) [] (0,n) $
    [(length $ filter ('o' /=) s, i) | (s,i) <- zip ss [1..]]
```

この問題は$N$が小さいのでそこまで考えなくてもできてしまうが、確かに、バケツソートで済む場面を見落とさないようにすることも大事だ。

# C - World Tour Finals

[問題 ABC323C](https://atcoder.jp/contests/abc323/tasks/abc323_c)

シグネチャを決める。

```haskell
abc323c :: Int      -- N
        -> Int      -- M
        -> [Int]    -- Ai
        -> [String] -- Si
        -> [Int]    -- 答え
```

各プレイヤーの現在の得点を数える。
最高得点とそれを持つ人を探す。

あとは、一般論では、それぞれのプレイヤーごとに、解いていない問題の配点を大きい順に貪欲に解き、合計点が現状の最高得点を上回る回答数を調べればよい。
ただしここで、最高得点を取っているのが一人だけの場合、その人は追加の必要がないことに注意が必要である。
最高得点の同着が複数人いる場合は、最高得点者についても同じ手続きでよい。と細かい場合分けが必要。

ところでこの問題では配点が100点刻みでプレイヤー数の上限が100人なので、ボーナス点を考えると点数が被ることはなく、同着は発生しない。
そこで、最高得点以上になるまでの回答数を考えるだけで、最高得点者本人もそれ以外も全て正しい結果が得られる。

## 結果

```haskell
import Data.List

abc323c :: Int -> Int -> [Int] -> [String] -> [Int]
abc323c _n _m as ss = zipWith f scores ss
  where
    scores = [i + sum [a | (a, 'o') <- zip as s] | (s, i) <- zip ss [1..]]
    scoremax = maximum scores
    f score s = length $ takeWhile (scoremax >) $ scanl (+) score $ sortBy (flip compare) [a | (a, 'x') <- zip as s]
```

## AtCoder構文

> プレイヤーiがまだ解いていない問題を少なくとも何問解くことで、プレイヤーiの総合得点が他のプレイヤー全員の現在の総合得点を上回ることができますか︖

目標を先に設定してくれた方が、そのための行動の意味が理解しやすいかなぁ？ということで例えば：

> プレイヤーiの総合得点が、他のどのプレイヤーの現在の総合得点も上回るようにするために必要な、プレイヤーiがさらに解くべき問題数は最小でいくつですか？

# D - Merge Slimes

[問題 ABC323D](https://atcoder.jp/contests/abc323/tasks/abc323_d)

シグネチャを決める。

```haskell
abc323d :: Int          -- N
        -> [(Int,Int)]  -- Si Ci
        -> Int          -- 答え
```

貪欲に、小さい方のスライムから考えて、可能な限り合成する。奇数なら一匹余り、これはもうどうにもならない。
合成で出現したスライムは、元からいた同じ大きさのスライムと合わせて、再度合成に回す、を繰り返す。

## 結果

```haskell
import qualified Data.IntMap as IM

abc323d :: Int -> [(Int,Int)] -> Int
abc323d _n scs = length $ loop $ IM.fromList scs
  where
    loop im
      | IM.null im = []
      | c == 1     = 1 : loop im1
      | odd c      = 1 : loop im2
      | otherwise  = loop im2
      where
        ((s, c), im1) = IM.deleteFindMin im
        im2 = IM.insertWith (+) (s + s) (div c 2) im1
```

## 解説を読む

上のやり方は、[公式解説](https://atcoder.jp/contests/abc323/editorial/7348)の補足と同じアイデア、つまり想定解ではないらしい。えっ？

想定解はいきなりややこしいことを言い出しているが、[popcount を使う方法 by Kiri8128](https://atcoder.jp/contests/abc323/editorial/7364)とあわせて読み解く。
スライムのサイズが奇数 $d$ を用いて $d \times 2^k$ と表せるようなもの同士は合成で合流しうるが、そうでないものは交わらないので、この $d$ を「タイプ」として分類する。
タイプ$d$サイズ$d \times 2^k$のスライム$2C$匹を全て合成すると、同じタイプ$d$倍サイズ$d \times 2^{k+1}$が$C$匹になる。奇数のときに1匹残して残りはさらに合成する、を、合流したサイズのものも含めて繰り返す様子を考えると、スライムの総重量は合成に関して不変であり、総重量を$d$で割った値（スコア）を2進数で表したときの1のビットが、可能な限り合成を行ったとき、奇数になって最後まで残るスライムに対応する。

結局、スライムのサイズからタイプを算出し、タイプごとにスコアを集計して、その1のビットの個数の総和が答えになる。

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

abc323d :: Int -> [(Int,Int)] -> Int
abc323d _n scs =
    sum $ map popCount $ IM.elems $
    IM.fromListWith (+)
    [(div s powk, c * powk) | (s,c) <- scs, let powk = s .&. negate s]
```

# E - Playlist

[問題 ABC323E](https://atcoder.jp/contests/abc323/tasks/abc323_e)

シグネチャを決める。

```haskell
abc323e :: Int    -- N
        -> Int    -- X
        -> [Int]  -- Ti
        -> Int    -- 答え
```

時刻0～$X$に関して、新たな曲を開始する瞬間になる確率を求める。
時刻0は1で、ある時刻から楽曲の長さ$T_i$過ぎた時刻はその$1/n$だけ確率を持つ。
時刻$(X-T_1+1)$～$X$から曲1を開始すると、時刻$X+0.5$では曲1が演奏中になるので、
それらの時刻での確率に$1/n$を掛けたものの和が求める確率である。

## 集めるDPによる解法

各時刻が曲の開始になる確率の上述の定義は配るDPと親和性が高いが、Haskellは集めるDPの方が得意なので、そのように言い直すと次のようになる。
ある時刻$T$の確率は、時刻$T - T_i$の確率に、曲$i$が選ばれる確率$1/n$を掛けたものの総和である。

```math
\begin{array}{l}
P[0] = 1 \\
P[T] = \frac{1}{n} \sum_{i=1}^N P[T - T_i] \\
P[T<0] = 0
\end{array}
```

```haskell
import Data.Array

abc323e :: Int -> Int -> [Int] -> Int
abc323e n x ts@(t1:_) = mul recipN $ reg $ summ $ drop (x - t1 + 1) $ elems pa
  where
    recipN = modRecip n -- 1/n のmodP
-- pa : 時刻0～Xが、新たな曲を選択して始めるタイミングになっている確率
    pa = listArray (0,x) $ map paf [0..x]
    paf 0 = 1
    paf t = mul recipN $ summ [pa ! t1 | t1 <- takeWhile (0 <=) $ map (t -) sts]
    sts = sort ts
```

`add, mul, summ, modRecip` は省略。
結果：[111ms, 10MB](https://atcoder.jp/contests/abc323/submissions/46444563)

## 配るDPによる解法

配るDPは、確定した要素の内容を順に配っていく、という命令的な側面があるので、純粋関数型で綺麗に表現できない。
（自分ができていないだけかもしれないが。）

命令的な計算をSTモナドで隠して、配るDPを計算する汎用的な関数を作ってみる。
確定する順序は添え字の `Data.Ix.range` 順とする。

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

distributingDP :: Ix i                 -- DP配列の添え字
               => (i,i)                -- DP配列の添え字の範囲
               -> x                    -- DP配列の初期値
               -> [(i,x)]              -- DP配列に初めから入る値
               -> (i -> x -> [(i,x)])  -- 配る関数
               -> (x -> x -> x)        -- 配られた値をくっつける関数
               -> Array i x            -- こたえ、DP配列
distributingDP bnds i inis df op = runSTArray $
  do
    arr <- newArray bnds i
    forM_ inis $ uncurry (writeArray arr)
    forM_ (range bnds) $ \i -> do
      x <- readArray arr i
      forM_ (df i x) $ \(j, y) -> do
        z <- readArray arr j
        writeArray arr j $! op y z
    return arr
```

これを使うと次のようになる。

```haskell
abc323e :: Int -> Int -> [Int] -> Int
abc323e n x ts@(t1:_) = mul recipN $ reg $ summ $ drop (x - t1 + 1) $ elems pa
  where
    recipN = modRecip n -- 1/n のmodP
-- 時刻0～Xが、新たな曲を選択して始めるタイミングになっている確率
    pa = distributingDP (0,x) 0 [(0,1)] df add
    df t p = [(t1, q) | let q = mul p recipN, t1 <- takeWhile (x >=) $ map (t +) sts]
    sts = sort ts
```

結果：[71ms, 11MB](https://atcoder.jp/contests/abc323/submissions/46395920)

# F - Push and Carry

[問題 ABC323E](https://atcoder.jp/contests/abc323/tasks/abc323_e)

倉庫番か。シグネチャを決める。手抜きする。

```haskell
abc323f :: [Int]  -- XA,YA,XB,YB,XC,YC
        -> Int    -- 答え
```

なんか毛色の変わった問題だ。

## 考える

人には簡単に見えて、コード化しようとすると案外面倒くさい話で、荷物の裏側に回り込まないといけない場合の歩数、その条件を網羅するのが大変に見える。
状況を整理するために正規化することを考える。
まず、目標地点 $(X_C,Y_C)$ を任意の位置とする代わりに、原点になるように全体を平行移動させる。

```haskell
abc323f [xa,ya,xb,yb,xc,yc] = step1 (xa - xc) (ya - yc) (xb - xc) (yb - yc)
```

次に、荷物の座標がいずれも正または0になるように、負のときは反転させる。

```haskell
step1 xa ya xb yb
  | xb < 0    = step2 (- xa) ya (- xb) yb
  | otherwise = step2 xa ya xb yb

step2 xa ya xb yb
  | yb < 0    = step3 xa (- ya) xb (- yb)
  | otherwise = step3 xa ya xb yb
```

さらに、もし荷物がY軸上にあるなら、軸を交換して転置する。

```haskell
step3 xa ya 0  yb = step4 ya xa yb 0
step3 xa ya xb yb = step4 xa ya xb yb
```

これで、荷物は必ず第１象限またはX軸上にある。

障害物を考えなければ、二つの地点の間を移動するステップ数はマンハッタン距離である。

```haskell
dist x1 y1 x2 y2 = abs (x1 - x2) + abs (y1 - y2)
```

一般の場合は、まず荷物の上隣または右隣のマスに移動し、そこから荷物を原点まで押すことになる。
上隣に移動した場合はまず下にX軸まで押し、2歩で荷物の右隣に移動し、さらに原点まで押す。
右隣に移動した場合も同様になる。この二つの選択肢から、小さい方を選ぶ必要があることが例1からわかる。

```haskell
step4 xa ya xb yb
  | otherwise = d1 + min dN dE + 2
  where
    d1 = dist xb yb 0 0           -- 荷物を押す距離
    dN = dist xa ya xb (succ yb)  -- 荷物の上隣までの距離
    dE = dist xa ya (succ xb) yb  -- 荷物の右隣までの距離
```

自分が荷物の真下方向あるいは真左方向にいるとき、荷物の上隣あるいは右隣に行くには回り込む必要がある。
そのような場合は、回り込まなくても行ける方を先に押す方が確実に早い。

```haskell
step4 xa ya xb yb
  | beS = d1 + dE + 2
  | beW = d1 + dN + 2
  | otherwise ...
  where
    beS = xa == xb && ya < yb  -- 荷物の真南にいる
    beW = ya == yb && xa < xb  -- 荷物の真西にいる
```

さらに、荷物がX軸上にあるときは、上隣に移動して下に押す必要がそもそもない。
ここで、真左方向にいるときは回り込みが必要、そうでないときは不要、という場合分けが起きる。

```haskell
step4 xa ya xb yb
  | yb == 0 = d1 + dE + if beW then 2 else 0
  | ...
```

これで場合を網羅できた。