ABC327 A～Fを Haskellで

- D : 二分グラフの判定、Union-Findによる方法
- E : DP ~~, LISライクな~~
- F : 区間更新セグメント木、尺取法、普通のセグメント木で重なり判定

# A - ab

[問題 ABC327A](https://atcoder.jp/contests/abc327/tasks/abc327_a)

シグネチャを決める。

```haskell
abc327a :: Int    -- N
        -> String -- S
        -> Bool   -- 答え
```

## 結果

便利な道具を使う方法
```haskell
import Data.List

abc327a _n s = isInfixOf "ab" s || isInfixOf "ba" s
```

自分で再帰を書く方法

```haskell
abc327a _n s = loop s
  where
    loop ('a':'b':_) = True
    loop ('b':'a':_) = True
    loop (_:s) = loop s
    loop "" = False
```

# B - A^A

[問題 ABC327B](https://atcoder.jp/contests/abc327/tasks/abc327_b)

シグネチャを決める。

```haskell
abc327b :: Int  -- B
        -> Int  -- 答え
```

$10^{18}$までのそのような値は

```haskell
> zip [1..] $ takeWhile (10^18 >=) [a ^ a | a <- [1..]]
[(1,1),(2,4),(3,27),(4,256),(5,3125),(6,46656),(7,823543),(8,16777216),(9,387420489),(10,10000000000)
,(11,285311670611),(12,8916100448256),(13,302875106592253),(14,11112006825558016),(15,437893890380859375)]
```

15個しかない。
何度も聞かれるならこれを`IntMap`に入れておいて検索するが、一度だけなので線形探索で済ませる。

## 結果

```haskell
abc327b b
  | apa == b  = a
  | otherwise = -1
  where
    (a, apa) = head $ dropWhile ((b >). snd) [(a, a^a) | a <- [1..]]
```

## 数値型の暗黙の型変換

> 公式解説「標準関数の `pow()` は勝手に浮動小数点数への型変換をして誤差が出るから、手書きでべき乗を作るよ！」  
> ユーザ解説「乗算を繰り返す代わりに、除算を繰り返す手書き計算でもできるよ！」

# C - Number Place

数独のことですね。

[問題 ABC327C](https://atcoder.jp/contests/abc327/tasks/abc327_c)

シグネチャを決める。

```haskell
abc327c :: [[Int]]  -- Ai,j
        -> Bool     -- 答え
```

それぞれの塊について判定するとき、『ソートした結果が `[1 .. 9]` と等しい』とやればそれで構わないのだが、何となくもったいないので、要素数9、値は1から9の整数、という制約が満たされてることを利用して、ビット演算でやってみよう。

## 結果

$3 \times 3$の列に分ける魔法 `cond3` は無詠唱では発動できない。

```haskell
import Data.List
import Data.Bits

abc327c :: [[Int]] -> Bool
abc327c ass = cond1 && cond2 && cond3
  where
    prop = all ((lll ==) . gather)
    cond1 = prop ass
    cond2 = prop $ transpose ass
    cond3 = prop $ map concat $ chunksOf 3 $ concat $ transpose $ map (chunksOf 3) ass

-- ビットiを全て立てた整数を作る
gather :: [Int] -> Int
gather = foldl' (\acc x -> acc .|. bit x) 0

-- [1..9]のビットが立った数
lll :: Int
lll = gather [1 .. 9]

-- Data.List.Splitより
chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf n xs = let (as,bs) = splitAt n xs in as : chunksOf n bs
```

最初に$A_{i,j}$を全て$2^{A_{i,j}}$に変換してしまえば、`gather` の中で `bit` を呼ぶ必要はなかったか。

# D - Good Tuple Problem

[問題 ABC327D](https://atcoder.jp/contests/abc327/tasks/abc327_d)

シグネチャを決める。

```haskell
abc327d :: Int    -- N
        -> Int    -- M
        -> [Int]  -- Ai
        -> [Int]  -- Bi
        -> Bool   -- 答え
```

$X_i$を頂点、$(S_i, T_i)$ を辺とするグラフが二分グラフになっているか判定せよ、と言っている。

## 市松PAINT解法

隣接する頂点を交互に塗り分けていく。
全体が連結とは限らないので、全ての頂点から出発してみる。
途中で同じ色の頂点を連結したら失敗、最後まで失敗しなかったら成功。

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

abc327d :: Int -> Int -> [Int] -> [Int] -> Bool
abc327d n _m as bs = loop g IM.empty [] [1..n]
  where
    g = accumArray (flip (:)) [] (1,n) $ zip as bs ++ zip bs as

loop :: Array Int [Int] -- 隣接リスト
     -> IM.IntMap Bool  -- 塗り分け
     -> [(Int,Bool)]    -- 塗り予定スタック
     -> [Int]           -- 開始予定頂点リスト
     -> Bool            -- 答え 最後までできたか
loop g im ((i,b):ibs) vs =
  case IM.lookup i im of
    Just c  -> b == c && loop g im ibs vs      -- 予定どおり塗り済みならスルー、矛盾なら投了
    Nothing -> loop g (IM.insert i b im) ([(j, not b) | j <- g ! i] ++ ibs) vs -- 塗ってなければそのように塗り、隣接頂点へ逆を展開
loop g im [] (v:vs)
  | IM.member v im = loop g im [] vs           -- vは処理済みならスルー
  | otherwise      = loop g im [(v,True)] vs   -- PAINTが途切れたら、次を補給する
loop _ _ [] [] = True                          -- 無事成功
```

## Union-Findを使う方法

元々考えているグラフを何らかの方法で塗り分けたとき、その色を交換した、ネガな塗り分けも成立する。
そこで、その両者が同時に存在するような世界を作る。

個々の頂点$X_i$について「$X_i$は0である」という事実と「$X_i$は1である」という事実を表す2つの頂点を持つグラフを考える。
二分グラフの辺「$X_S \neq X_T$ であるような $(S,T)$」に対して、
「$X_S$は0である」と「$X_T$は1である」を接続し、「$X_S$は1である」と「$X_T$は0である」も接続する。

こうして辺を張っていったとき、元のグラフが二分グラフなら、いすずジェミニのCMのように、両者はぶつかることなくクネクネする。
二分グラフとして破綻している辺があるとき、$X_i$のいずれかについて、「0である」「1である」の頂点が連結になる。

よって、倍増させた世界のグラフをUnion-Findに入れて、連結性を判断することで答えが得られる。

```haskell
import qualified Data.IntMap as IM

abc327d :: Int -> Int -> [Int] -> [Int] -> Bool
abc327d n _m as bs = not $ or $ zipWith (findUF ufN) [1 .. n] [succ n ..]
  where
    ufN = foldl' step newUF $ zip as bs
    step uf (a, b) = uniteUF (uniteUF uf a (b + n)) (a + n) b

-- @gotoki_no_joe
type UnionFind = IM.IntMap Int

-- 空虚なUnion-Find
newUF :: UnionFind

-- findUF uf a b : ufでaとbが連結か判定
findUF :: UnionFind -> Int -> Int -> Bool

-- uniteUF uf a b : ufからaとbを接続したUnion-Findを返す
uniteUF :: UnionFind -> Int -> Int -> UnionFind
```

[提出](https://atcoder.jp/contests/abc327/submissions/47286539)

# E - Maximize Rating

[問題 ABC327E](https://atcoder.jp/contests/abc327/tasks/abc327_e)

シグネチャを決める。

```haskell
abc327e :: Int     -- N
        -> [Int]   -- Pi
        -> Double  -- 答え
```

レートの式の各部を次のように呼ぶことにする。

```math
R = \frac{\sum_{i=1}^k (0.9)^{k-i}Q_i}{\sum_{i=1}^k (0.9)^{k-i}} - \frac{1200}{\sqrt k} = \frac{A_k}{B_k} - C_k
```

$C_k$は単純に$k$から求められる。
$B_k$は $0.9$ のべき乗の和で、$k$が1増えると項が1つ増える。
$B_1 = 1, B_{k+1} = 1 + 0.9B_k$ と表せる。$C_k$も$B_k$も、$Q_i$は影響しない。
$A_k$は、古くなるごとに$Q_i$を0.9倍して影響を下げようとしている式である。$A_0 = 0, A_{k+1} = 0.9A_k + Q_k$ と表せる。この要素だけが$Q_i$の影響を受ける。
そしてこれを大きくすることで、$R$を大きくできる。

ここから、~~LISと同様の発想で~~ 基本的なDPで答えを導く。

$P_i$を前から$j$個まで考えたとき、そこから$k$個選んだときの$A_k$の最大値を、$k$ごとに記録する。
最後まで調べたあと、実際のレートを計算し、最大値を選ぶ。

## 結果

```haskell
import Data.List

abc327e :: Int -> [Int] -> Double
abc327e n ps = maximum rs
  where
    ssN = foldl step [] ps
    step ss pi = zipWith max (ss ++ [0]) (map ((fromIntegral pi +) . (0.9 *)) (0:ss))
    rs = zipWith3 r ssN (iterate ((1 +) . (0.9 *)) 1) [1200 / sqrt k | k <- [1..]]
    r a b c = a / b - c
```

# F - Apples

[問題 ABC327F](https://atcoder.jp/contests/abc327/tasks/abc327_f)

シグネチャを決める。$T_i, X_i$は手抜きする。

```haskell
abc327f :: Int      -- N
        -> Int      -- D
        -> Int      -- W
        -> [[Int]]  -- Ti, Xi
        -> Int      -- 答え
```

端の処理がちょっと気になる。
時刻$S$を選ぶと、$S-0.5$にカゴを置くので、時刻$S$のりんごは確保する。
$S+D-0.5$にカゴを戻すので、時刻$S+D$のりんごは確保できない。
位置$X$についても同様。整数の開区間でやりたいなら、0.5とか持ち出さずに説明しようよ。

## 二次元累積和による（失敗した）やり方

時刻とX座標の位置からなる二次元空間を考えると、りんご$(T_i,X_i)$を確保できるような$(S,L)$の選び方は、$T_i - W + 1 \leq S \leq T_i, X_i - W + 1 \leq L \leq X_i$ という長方形をなす。
片側開区間で表すと $T_i - W + 1 \leq S < T_i + 1, X_i - W + 1 \leq L < X_i + 1$ となる。全体を1ずつずらしても答えは同じなので $T_i - W \leq S < T_i, X_i - W \leq L < X_i$ とする。
このような折り紙の重ね合わせをして、一番厚いところは何枚か、という問題になる。
時刻や座標が疎なので、大小関係を保って座標圧縮して配列の添え字として、二次元累積和をすれば求められる、はずだった。

すごく重なりのない、小さな折り紙を全体に散らすと、$4 \times 10^5 \times 4 \times 10^5$ 要素の配列の累積和をとることになって、見事に撃沈された。

## 尺取+区間更新セグメント木

上の方法は全ての座標、全ての時刻を一斉に考えるが、カゴの存在範囲の外にあるりんごは結果に影響を与えないので、もっと局所的な分析で計算できるはず。

りんごを時刻順に整列すると、時間幅$D$に到着する範囲のりんごを切り出すことができる。尺取法を適用するために、尺の位置を進めたときに、状態遷移が小さく計算できるようにする必要がある。

### セグメント木

配列があり、その連続する範囲について計算した結果を求めたり、要素の値を変更したりする計算が入り交じるときに、一つの操作を$O(\log N)$で行える効率的なデータ構造。例えばここでは `max` を演算とする。

元の配列の要素を隣同士で演算を施すトーナメントを、要素が1になるまで行い、そのそれぞれの試合にノードを対応させた木を作る。ノードには試合結果と、関係する配列要素の添え字の範囲がラベル付けされる。決勝戦は全ての要素、準決勝戦は全体を前半と後半に二分した範囲、…、が対応付く。

<table>
<tr><td colspan="8">[0,8) max = 9
<tr><td colspan="4">[0,4) max = 4<td colspan="4">[4,8) max = 9
<tr><td colspan="2">[0,2) max = 3<td colspan="2">[2,4) max = 4<td colspan="2">[4,6) max = 9<td colspan="2">[6,8) max = 6
<tr><td>[0,1) <br> 3<td>[1,2)<br> 1<td>[2,3)<br> 4<td>[3,4)<br> 1<td>[4,5)<br> 5<td>[5,6)<br> 9<td>[6,7)<br> 2<td>[7,8)<br> 6
</table>

元の配列の要素数$N$を2のべき乗と仮定する。上の表に示した木は、ヒープソートのヒープと同様に、要素数$2N-1$の配列に格納でき、添え字を0始まりとして、添え字を2で割ると親へ、2倍して1を足すと左の子、2を足すと右の子になる。元の配列の要素は第$N-1$要素から始まる。

初期値を持つこのような配列は、次のように作れる。（immutable arrayなので説明用）

```haskell
-- 長さ8の配列のSegment Tree (演算はmax)
stArr1 = listArray (0,14) $
         [max (stArr ! (i * 2)) (stArr ! (i * 2 + 1)) | i <- [0..6]] ++
         [3,1,4,1,5,9,2,6]
```

このような木があると、ある範囲$[a,b)$の要素の最大値を求めるのに、木の中間ノードが持つ区間とその結果を利用して、当てはまる最大の区間の結果と、残りの区間についても再帰的に求めて、それらの `max` をとればよい。
例えば区間 [3,6) の値は、区間 [3,4) と区間 [4,6) の値から求められる。

```haskell
-- 長さ8のSegment Treeの範囲[a,b)の最大値を求める
getMax stArr a b = loop 0 8 0
  where
    loop p q i
      | q <= a || b <= p = 0          -- 現在のノードiは完全に範囲外
      | p <= a && b <= p = stArr ! i  -- 現在のノードiは範囲に完全に含まれている
      | otherwise = max l r           -- 現在のノードiは範囲にかかっている
      where
        m = div (p + q) 2         -- 中間点
        l = loop p m (i * 2 + 1)  -- 左右の部分木に問い合わせ
        r = loop m q (i * 2 + 2)
```

元の配列の特定の要素を書き換えるときは、対応する葉ノードから根までの全ての頂点の値だけを再計算する必要がある。

```haskell
-- 元配列の第i要素をxに変更したSegment Treeを作る
alter stArr i x = loop (arr // [(i + 7, x)]) (i + 7)
  where
    loop arr 0 = arr          -- 根まで更新完了
    loop arr i = loop (arr // [(p, max l r)]) p
      where
        p = div i 2           -- 親
        l = arr ! (p * 2 + 1) -- どちらがiだかわからない～
        r = arr ! (p * 2 + 2)
```

これでセグメント木の概要を具体例で説明できた。
演算を任意にし、サイズを任意にし、配列もmutableなものにすると、汎用的なセグメント木が作れる。

今回、初期値の設定はいらない。特定の要素の更新もいらない。
任意の範囲の最大値の取得すらいらない。（全体、だけでよい。）
その代わり、任意の範囲に対して、同じ変更（値を足し込む）を効率的に行いたい。

### 区間更新セグメント木

上の `alter` のような書き換えでなく、区間の要素全てに x を足し込む、という操作を考える。
全ての要素に足し込まれるので、最大値もこれまでの値に x を足し込んだものになる。
この足し込み情報を、葉へ反映させる代わりに、範囲が完全に含まれるノードについて、それに残すことを考える。その後、最大値を問い合わされたときは、元と同じ方法で答えを求めて、その結果に x を足し込んで返せばよい。

足し込み情報は、範囲の端については、ちょうどの切れ目のところまで葉の方までなでつけられ、中程は根に近い高さで止まるイメージになる。
例えば、区間 [1,5) に対する更新は、区間 [1,2), [2,4), [4,5) に記録される。

更新値を保持するために、普通のセグメント木の配列と同じだけの配列がもう一つ必要になる。
その初期値はオール0でよい。

```haskell
-- 長さ8の配列の区間更新Segment Tree (問い合わせ演算はmax, 更新演算は(+))
ruSTArr1 = (stArr1, ruArr1)
  where
    ruArr1 = listArray (0,14) $ replicate 15 0
```

上述のとおり、問い合わせは元と同様にした後で更新値を足し込む。

```haskell
-- 長さ8の区間更新Segment Treeの範囲[a,b)の最大値を求める
ruGetMax (stArr, ruArr) a b = loop 0 8 0
  where
    loop p q i
      | q <= a || b <= p = 0              -- 現在のノードiは完全に範囲外
      | p <= a && b <= p = x + stArr ! i  -- 現在のノードiは範囲に完全に含まれている
      | otherwise = x + max l r           -- 現在のノードiは範囲にかかっている
      where
        m = div (p + q) 2         -- 中間点
        l = loop p m (i * 2 + 1)  -- 左右の部分木に問い合わせ
        r = loop m q (i * 2 + 2)
        x = ruArr ! i
```

さて肝心の区間更新を適用するには、もちろんまず、該当する全ノードの `ruArr` に更新値を足し込むことが必要である。また、そうすることで、そのノードに対する問い合わせの結果も変わるので、そのことを親ノードの `stArr`に反映させる必要がある。`stArr1` の式の2行めの計算を、該当ノードのみについて行うことに相当する。

```haskell
-- 元配列の区間[a,b)にxを足し合わせた区間更新Segment Treeを作る
ruAlter arrs a b x = loop 0 8 0 arrs
  where
    loop p q i arrs@(stArr, ruArr)
      | q <= a || b <= p = arrs                           -- 現在のノードiは完全に範囲外
      | p <= a && b <= p = (stArr, accum ruArr [(i, x)])  -- 現在のノードiは範囲に完全に含まれている
      | otherwise = (stArr2 // [(i, max l r)], ruArr2)    -- 現在のノードiは範囲にかかっている
      where
        m = div (p + q) 2
        arrs1 = loop p m (i * 2 + 1) arrs  -- 左右の部分木へ更新を伝播
        arrs2 = loop m q (i * 2 + 2) arrs1
        l = read (i * 2 + 1)
        r = read (i * 2 + 2)
        (stArr2, ruArr2) = arrs2
        read i = stArr2 ! i + ruArr2 ! i
```

これで区間更新セグメント木の概要を具体例で説明できた。
演算を任意にし、サイズを任意にし、配列もmutableなものにすると、汎用的な区間更新セグメント木が作れる。
ただ、今回は問い合わせ演算を `max` 更新演算を `(+)` としたのでこうなったが、問い合わせ演算も `(+)` のときは、結果は更新で足し込む値をさらに要素数倍する（あるいは、子ノードに伝播させるときに半々にしていく）ような処置が必要になる。
AtCoder Libraryのそれはこの辺りも対応した汎用的なライブラリになっているようなので、もう少し勉強します。

### 特化

ABC327Fで使うにおいては、初期値は必要なく、`stArr`の末尾$N$要素は不要である。（が、面倒なのでそのままにしておく。）
区間を対象とする問い合わせ `ruGetMax`（$O(\log N)$）は不要で、全体に対するものだけでよい。それは、根ノード、配列の先頭に入っている値を読み出すだけの$O(1)$の計算になる。
さらにいうと、問い合わせは`ruAlter`の直後に必要になり、`ruAlter`で現在更新したノードの値を返すことにすると、上のコードの `arr1`, `arr2`, `l`, `r` が次のようになって都合がよい。

```haskell
        (l, arrs1) = loop p m (i * 2 + 1) arrs
        (r, arrs2) = loop m q (i * 2 + 2) arrs1
```

尺取している時間幅に次のりんごが入ってきたときには、そのカゴ範囲を+1して最大値を調べ、りんごが抜けるときには-1して、をりんごが尽きるまで行い、調べた最大値の最大が答えになる。


### 結果

[775ms 143MB](https://atcoder.jp/contests/abc327/submissions/47357486) `Data.Vector.Unboxed.Mutable` で実装した。

[アライさんによると](https://twitter.com/kyopro_friends/status/1720800653092835638)ABC211Fが類題のようなので、そのうちに。

## 区間更新でないセグメント木

[ユーザ解説 by potato167](https://atcoder.jp/contests/abc327/editorial/7588)にさらっと

> 公式解説では区間加算、区間 max の遅延セグメントツリーを用いて解いてますが、これは一点加算、累積和 max のセグメントツリーで同じことができるからです。

と（だけ）あるのが意味わからん。
[添付されているソース](https://atcoder.jp/contests/abc327/submissions/47283704)を解読するしかない。

まず、最初に時刻でソートするところを、真面目な$O(N \log N)$アルゴリズムでなくて、時刻全体のバケツソートでやっている。
なんという富豪スタイル。輸入した結果：
[423ms 100MB](https://atcoder.jp/contests/abc327/submissions/47369059)

そして、区間更新セグメント木でする代わりに、一点更新セグメント木でするマジック。
要素の値として、(区間左からの累積和, 区間の累積和の最大値) という対をとる。
単位元は (0,0) で、演算は次のようにできる。

```haskell
op :: (Int,Int) -> (Int,Int) -> (Int,Int)
op (sumL, maxL) (sumR, maxR) = (sumL + sumR, max maxL $ sumL + maxR)
```

このセグメント木に対して、左端からの値をみたとき、真の累積和と真の最大値が取り出せる。
葉には、累積和による積分の方法と同様の微分値を設定すると、結果的に、二次元累積和と同じ計算が実行される。

カゴを置く位置候補として $X_i - W$ は負の値を取り得るが、問題の要求として $0 < L$ であることから、この値を0でクランプするなど細かい点に注意して、完成。
[464ms 94MB](https://atcoder.jp/contests/abc327/submissions/47370905)

# G - Many Good Tuple Problems

解説が4本も生えている…