ABC285 A～F をHaskellで

# A - Edge Checker 2

[問題 ABC285A](https://atcoder.jp/contests/abc285/tasks/abc285_a)

シグネチャを決める。

```haskell
abc285a :: Int   -- a
        -> Int   -- b
        -> Bool  -- 答え
```

これは、アルゴリズムとデータ構造の講義で習う、配列によるヒープの実現において配列の要素を二分木のノードに対応付けるやり方。

子ノードから見たとき、整数除算で、自分の添え字を2で割った商が親の添え字。
親ノードから見たとき、自分の添え字を倍にしたものが左の子の、それ+1が右の子の添え字。

## 結果

```haskell
abc285a a b = a == div b 2
```

# B - Longest Uncommon Prefix

[問題 ABC285B](https://atcoder.jp/contests/abc285/tasks/abc285_b)

シグネチャを決める。

```haskell
abc285b :: Int     -- N
        -> String  -- S
        -> [Int]   -- 答え
```

何だかすごく意味の取りにくい問題文。

> > > 文字列 $S$ のとある文字 $S_k$ と、とある固定幅 $i$ だけ後ろの位置の文字 $S_{k+i}$ が異なっている $(S_k \neq S_{k+i})$
> >
> > という条件が、$S$ の先頭から何文字目まで満たされているか、という文字数 $l \leq N-i$ $(\forall k, 1 \leq k \leq l \Rightarrow S_k \neq S_{k+i})$
>
> を、$i=1,2,\dots,N-1$ それぞれについて求めよ

と言っている。

簡単に言い直すと、$S$ と、$S$ の前から $i$ 文字を落とした文字列とで、先頭何文字目まで違うか数えればよい。

## 結果

```haskell
abc285b n s =
  [ length $ takeWhile id $ zipWith (/=) s $ drop i s
  | i <- [1 .. pred n]
  ]
```

# C - abc285_brutmhyhiizp

[問題 ABC285C](https://atcoder.jp/contests/abc285/tasks/abc285_c)

シグネチャを決める。

```haskell
abc285c :: String  -- S
        -> Int     -- 答え
```

単純に、`A` が0 ～ `Z` が 25 という26進数だという訳にはいかない。これだと `A` も `AA` もどちらも0になってしまう。
では `A` が1 ～ `Z` が26 という27進数、とすると、今度は、10進数で例えると 9 の次が 10 にならず 11 となってしまう。（零を表す文字がないから）

少し手間をかけて、

- 長さちょうど $K$ 文字のIDがいくつあるか
- 長さちょうど $|S|$ 文字のIDのうち、$S$ は何番目か

を考え、$1 ～ |S|-1$ に対する前者と後者の総和が $S$ の番号になる。
前者は $26^K$ 個で、後者は上記の、`A` が0 ～ `Z` が 25 という26進数で求められる（ただし0始まり）。

## 結果

前者の総和を、等比級数の和の公式を使って求めてもよい。

```haskell
import Data.Char

abc285c s = sum $
  foldl step 0 s :
  take (length s) (iterate (26 *) 1)

step acc c = acc * 26 + ord c - ord 'A'
```
## 追記：別解

`A` が　1 ～ `Z` が **26** という **26**進数、とする、位取り記法としては奇妙な割り当てをすると、`"Z"` が 26番目、`"AA"` が $26+1=27$ 番目で、隙間なく数え上げられるそうな。

```haskell
abc285c :: String -> Int
abc285c = foldl step 0
 
step acc c = acc * 26 + ord c - ord 'A' + 1
```

このことに関した記事がありましたのでリンク：[ABC285 C問題：ゼロを使わないN進法についてのメモ](https://qiita.com/HMMNRST/items/e9e68d58de3a1d1d7c85)

# D - Change Usernames

[問題 ABC285D](https://atcoder.jp/contests/abc285/tasks/abc285_d)

シグネチャを決める。

```haskell
abc285d :: Int               -- N
        -> (String, String)  -- Si, Ti
        -> Bool              -- 答え
```

名前をノードとし、名前の変更を有向辺とするグラフを考える。
初期状態で名前に衝突はなく、各自一度だけ名前を変えるので、このグラフに分岐はない。

グラフに合流があると、同じ名前の取り合いになるので不可能。

分岐も合流もないとき、例2のように、グラフにループがあると、誰かが一度脇にどかない限り動き出せなくて不可能。

ループもないとき、一本道が何本かあるだけで、それは端から動けば移動を完了できる。

## 結果

名前の衝突は、$T_i$ に重複があるかで確認できる。

ループの存在は、UnionFind で検出できる。
既に同じグラフに属している間を繋いだとき、それは分岐を合流させたかループが発生したかのいずれかで、合流がないことは上で確認している（し、分岐は起きない）ので、それはループに違いない。

名前はたかだか8文字なので、衝突がないように整数を割り当てて、`Map`, `Set` でなく `IntMap`, `IntSet` で扱うことで高速化を図る。それには1始まりの27進数を使えばよい。
（隙間なくみっしりと番号を割り当てて配列で処理したいならば、$S_i$ と $T_i$ を全て持つ `Set` に `findIndex` する。）

```haskell
import Data.Char
import qualified Data.IntSet as IS

abc285d n sts = noJoin && noLoop
  where
    ss = map (s2i . fst) sts
    ts = map (s2i . snd) sts
    noJoin = IS.size (IS.fromList ts) == n
    noLoop = iter newUF $ zip ss ts

iter _ [] = True
iter uf ((s,t):sts) =
  case uniteUF uf s t of
    Nothing  -> False
    Just uf1 -> iter uf1 sts

-- 名前に衝突のない整数を割り当てる
s2i :: String -> Int
s2i = foldl step 0
  where
    offset = pred $ ord 'a'
    step acc c = acc * 27 + ord c - offset
```

# E - Work or Rest

[問題 ABC285E](https://atcoder.jp/contests/abc285/tasks/abc285_e)

シグネチャを決める。

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

休日1日+平日 $k (\geq 0)$ 日、という$k+1$日をひとつのブロックとして、これが並んで合計 $N$ 日という状況を考える。

ブロックの最終日は、翌日が次のブロックの先頭の休日になっていることを考えると、ブロックの生産量 $G$ は以下のようになる。

| $k$ | $G$ |
|---|:---|
| $2j$ | $A_1 + A_2 + \dots + A_j \phantom{ + A_{j+1}} + A_j + \dots + A_2 + A_1$ |
| $2j + 1$ | $A_1 + A_2 + \dots + A_j + A_{j+1} + A_j + \dots + A_2 + A_1$ |

このブロックを並べて $M$ 日の予定を作ったときの生産量の最大値 $G_{max}(M)$ は、

- $k = M$ のブロックの生産量 $G(k=M)$
- $i = 1, \dots$ について $G_{max}(i) + G_{max}(M-i)$

のうちの最大値である。
これを $M=1,2,\dots,N$ と順に求めて、$G_{max}(N)$ が答えである。

## 結果

```haskell
import Data.Array

abc285e :: Int -> [Int] -> Int
abc285e n as = gmax ! n
  where
    gains = 0 : mkGains 0 as
    gmax = listArray (1,n) $ zipWith gfun [1..n] gains
    gfun m gm = maximum (gm : [gmax ! i + gmax ! (m - i) | i <- [1..div m 2]])

mkGains g0 (a:as) = g1 : g2 : mkGains g2 as
  where
    g1 = g0 + a
    g2 = g1 + a
```

# F - Substring of Sorted String

[問題 ABC285F](https://atcoder.jp/contests/abc285/tasks/abc285_f)

列 $S$ をクエリ1によって更新しつつ、その区間 $[l,r]$ についてクエリ2で問い合わせをされる。という構造だと、セグメント木が当てはまったらうれしいな、ということで考える。

「文字列$S$の$i$文字目」を$S[i]$と、
「文字列$S$の$l$文字目から$r$文字目からなる文字列」を$S[l,r]$ と表記する。

「$S[l,r]$が$S$を整列した$T$の部分文字列になっている」ということは、

- $S[l,r]$は昇順でなくてはならない。
このとき、$S[l,r]$に含まれる文字 $c$ は $S[l] \leq c \leq S[r]$ の範囲にある、とわかる。
- $T$から$S[l,r]$を切り取った残りには、切断面の文字が両方にまたぐことはあっても、それ以外の文字は整列により大小関係で位置が決まるので、$S[1,l-1]$ と $S[r+1,N]$ に含まれる文字 $c$ は $c \leq S[l] \lor S[r] \leq c$ でなければならない。

この2点を高速に検査しなくてはならない。

前者は、$i$ 文字目と次の文字が昇順になっているか否かの真理値のリスト $I[i] = (S[i] \leq S[i+1])$ に対して、これの論理積をとるセグメント木を作ればよい。
$x$ 文字目を差し替えるとき、$I[x]$ だけでなく $I[x-1]$ も変化することに注意が必要である。またこのため、$S$ の内容も保持しておく必要がある。

後者は、要素の種類がたかだか26であることを利用して、区間に含まれる文字種のビット集合を持つセグメント木を作る。つまり、`A` を $2^0$ ～ `Z` を $2^{25}$ とビットで表し、演算はこれの論理和とする。

## 結果

$S$ は、添え字を1始まりになるように先頭にダミー要素を追加し、右端を更新したときにそのさらに右隣がないことでの場合分けを回避するためのダミーを末尾に追加しておく。


```haskell
import Control.Monad
import Data.Char
import Data.List
import Data.Bits
import qualified Data.Vector.Unboxed.Mutable as MUV
import qualified Data.Vector.Unboxed as UV

main = do
  n <- readLn
  s <- getLine
  let s1 = 'a' : s ++ "z" -- 添え字ずらしと番兵
  sv <- UV.thaw $ UV.fromList s1 -- Sを保持する IOVector
  t1 <- makeSegTree (zipWith (<=) s1 (tail s1)) (&&) True -- 単調増加のセグメント木
  t2 <- makeSegTree (map bee s1) (.|.) 0  -- ビット集合のセグメント木
  q <- readLn
  replicateM q $ do
    l <- getLine
    case words l of
      ['1':_, xs, c:_] -> -- Sの位置xをcに更新
        do
          let x1 = read xs
          MUV.write sv x1 c
          writeSegTree t2 x1 (bee c)
          let x0 = pred x1
          c0 <- MUV.read sv x0
          writeSegTree t1 x0 (c0 <= c)
          c2 <- MUV.read sv (succ x1)
          writeSegTree t1 x1 (c <= c2)
      ['2':_, ls, rs]  -> -- l から r が昇順で、はみ出しがないか調べる
        do
          let l = read ls
          let r = read rs
          mono <- querySegTree t1 l r
          bsL  <- querySegTree t2 0 l
          bsR  <- querySegTree t2 (succ r) (n+2)
          let bs = bsL .|. bsR
          min1 <- MUV.read sv l
          max1 <- MUV.read sv r
          let ans = mono && null [() | c <- [succ min1 .. pred max1], bee c .&. bs /= 0]
          putStrLn $ if ans then "Yes" else "No"

bee :: Char -> Int
bee c = bit $ ord c - ord 'a'

-- @gotoki_no_joe
-- セグメント木
data SegmentTree a = SegmentTree Int (a->a->a) a (STree a)

type STree a = MUV.IOVector a

-- 初期値リスト、演算、単位元をとり、セグメント木を作る
makeSegTree :: MUV.Unbox a => [a] -> (a->a->a) -> a -> IO (SegmentTree a)
makeSegTree xs op u = do
  let len = length xs
  let w = until (len <=) (2 *) 1
  vec <- MUV.new (w * 2 - 1)
  forM_ (take w $ zip [pred w..] (xs ++ repeat u))
        (uncurry (MUV.write vec))
  forM_ [w-2,w-3..0] (\k -> do
    l <- MUV.read vec (k*2+1)
    r <- MUV.read vec (k*2+2)
    MUV.write vec k (op l r)
    )
  return $ SegmentTree w op u vec

-- 木と位置と値をとり、セグメント木を更新する
writeSegTree :: MUV.Unbox a => SegmentTree a -> Int -> a -> IO ()
writeSegTree (SegmentTree w op _ vec) j x =
  do
    MUV.write vec i0 x
    forM_ upwards (\i -> do
      l <- MUV.read vec (i*2+1)
      r <- MUV.read vec (i*2+2)
      MUV.write vec i (op l r)
      )
  where
    i0 = j + w - 1
    upwards = tail $ takeWhile (0 <=) $ iterate step i0
    step i = div (pred i) 2

-- 木と区間 [左,右) をとり、値を取り出す
querySegTree :: MUV.Unbox a => SegmentTree a -> Int -> Int -> IO a
querySegTree (SegmentTree w op u vec) a b = loop vec 0 w w 0
  where
    loop vec p q w i
      | q <= a || b <= p = return u
      | a <= p && q <= b = MUV.read vec i
      | otherwise = do
        let w2 = div w 2
        let m = p + w2
        l <- loop vec p m w2 (i*2+1)
        r <- loop vec m q w2 (i*2+2)
        return (op l r)
```