ABC398 A～F をHaskellで

# A - Doors in the Center

[問題 ABC398A](https://atcoder.jp/contests/abc398/tasks/abc398_a)

シグネチャを決める。

```haskell
abc398a :: Int -- N
        -> String -- 答え
```

- $N$ が奇数のとき、`=`が中央に1文字、前後に`-`が $(N-1)/2$ 文字ずつ
- $N$ が偶数のとき、`=`が中央に2文字、前後に`-`が $N/2-1 = (N-2)/2$ 文字ずつ

という文字列を作ればよい。
整数除算における切り捨てにより、`-`の長さは同じやり方で計算できる。

## 結果

```haskell
abc398a n
  | even n    = s ++ "==" ++ s
  | otherwise = s ++ '='   : s
  where
    s = replicate (div (pred n) 2) '-'
```

# B - Full House 3

[問題 ABC398B](https://atcoder.jp/contests/abc398/tasks/abc398_b)

シグネチャを決める。

```haskell
abc398b :: [Int] -- Ai
        -> Bool  -- 答え
```

## リストで解く

同じカードの枚数を数え、枚数の多い方から2つを考える。
最大の方が3枚以上、次点が2枚以上あれば、フルハウスを作れる。

```haskell
import Data.List

abc398b :: [Int] -> Bool
abc398b as =
   case sortBy (flip compare) $ map length $ group $ sort as of
    a:b:_ -> a >= 3 && b >= 2
    _     -> False
```

## 配列によるカウントで解く

同じカードの枚数を数える。
次に、同じカードの枚数が2枚以上である数の種類数、3枚以上である数の種類数を数える。
後者は前者に含まれるため、前者が2つ以上、後者が1つ以上あることがフルハウスを作れる条件である。

```haskell
import Data.Array

abc398b :: [Int] -> Bool
abc398b as = count 2 >= 2 && count 3 >= 1
  where
    cnt = accumArray (+) 0 (1,13) [(a,1) | a <- as] :: Array Int Int
    count x = length $ filter (x <=) $ elems cnt
```

# C - Uniqueness

[問題 ABC398C](https://atcoder.jp/contests/abc398/tasks/abc398_c)

シグネチャを決める。

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

[アライさんいわく](https://x.com/kyopro_friends/status/1903442494765109345)
> アライグマ「dict[x]=xを持ってるヒトの番号の集合、みたいな辞書を作ったり、Aiをソートしたりすればいいのだ！」

両方やってみる。

## 辞書を作る方法

数 $A_i$ をキーに、その数を持っている人の番号 $i$ のリストを値とする `IntMap` を作る。
リストが単一要素な最大のキーの、そのリストの内容が答えである。
番兵を忍ばせておく。

```haskell
import qualified Data.IntMap as IM

abc398c :: Int -> [Int] -> Int
abc398c n as = head cands
  where
    im = IM.fromListWith (++) $ (minBound, [-1]) : [(a,[i]) | (a,i) <- zip as [1 ..]]
    cands = [i | (_a, [i]) <- IM.toDescList im]
```

## ソートする方法

つい、$A_i$ に $i$ を添えてソートしたくなるが、答えは唯一な $A_i$ の $i$ なので、後で探し直せばいい。計算量は変わらない。

```haskell
import Data.List

abc398c :: Int -> [Int] -> Int
abc398c _n as = ans
  where
    [ai] = head $ filter isSingleton $ group $ sortBy (flip compare) $ minBound : as
    Just ans = lookup ai $ (minBound, -1) : zip as [1 ..]

isSingleton :: [a] -> Bool
isSingleton [_] = True
isSingleton _ = False
```

# D - Bonfire

[問題 ABC398D](https://atcoder.jp/contests/abc398/tasks/abc398_d)

シグネチャを決める。

```haskell
abc398d :: [Int]  -- N,R,C
        -> String -- S
        -> String -- 答え
```

指示と逆の方向に原点と焚き火を動かす。

## 結果

```haskell
import qualified Data.Set as S
import Data.Bool

abc398d :: [Int] -> String -> String
abc398d [_n, r, c] str = ans
  where
    (_, ans) = mapAccumL step (0,0,S.singleton (0,0)) str
    step (ox,oy,s) 'N' = post (succ ox) oy s
    step (ox,oy,s) 'E' = post ox (pred oy) s
    step (ox,oy,s) 'W' = post ox (succ oy) s
    step (ox,oy,s) 'S' = post (pred ox) oy s
    post ox oy s = ((ox, oy, S.insert (ox,oy) s), if S.member (ox + r, oy + c) s then '1' else '0')
```

# E - Tree Game

[問題 ABC398E](https://atcoder.jp/contests/abc398/tasks/abc398_e)

## 考える

番号1の頂点から、頂点を交互に白黒に塗り分ける。
こうすると、同じ色の頂点どうしを繋ぐと、奇閉路が発生する。
色が違う頂点どうし（で間に辺がないもの）を繋ぐと、偶閉路が完成する。さらに繋いでいっても問題は起きない。
なので、そのような辺が何本引けるかを考え、奇数なら先手、偶数なら後手を選び、
後は、まだ取られていないものを好きに選んでいけばよい。

## Data.Setでする

対話形式だけど immutable に書きたいので、`Data.Set` だけでやってみる。
グラフは、$i$ $j$ 間に辺があるとき $(i,j)$ を持つ集合で表現する。

```haskell
-- uvs :: [[Int]] -- Ui, Vi
    g = S.fromList $ concat [[(u,v),(v,u)] | u:v:_ <- uvs]
```

このグラフを頂点1から再帰降下し交互に塗り分け、1と同じ色の頂点の集合を作る。

```haskell
    blacks = S.fromList $ recur 0 1 True
-- p:vの親 v:現在の頂点 b:黒 c:vの子
    recur p v b = [v | b] ++ [vb | c <- [1 .. n], S.member (v,c) g, c /= p, vb <- recur v c (not b)]
```

張れる辺の集合を作る。色の違う頂点どうしで、`g` には辺がないもの。

```haskell
    ans = S.fromList
      [ (i,j)
      | i <- [1 .. pred n], j <- [succ i .. n]
      , S.member i blacks /= S.member j blacks
      , S.notMember (i,j) g]
```

`ans`の要素数が奇数なら先手、偶数なら後手を選び、
自分の番のとき最小要素を選んで返し、相手の手は自分のリストから削除する、
という対話プログラムを実装する。
[結果](https://atcoder.jp/contests/abc398/submissions/64198195)

# F - ABCBA

[問題 ABC398F](https://atcoder.jp/contests/abc398/tasks/abc398_f)

答えは S を接頭辞に持つので、答えの前半は S そのものになる。
回文を構成するような、残りの部分だけを返すことにして、シグネチャを決める。

```haskell
import qualified Data.ByteString.Char8 as BS

abc398f :: BS.ByteString -- S
        -> BS.ByteString -- 答え
```

32個もの `after_contest` が突っ込まれている。どんな嘘解答があったやら。

## Manacher（直径奇数）

Manacherというアルゴリズムがあって、文字列の各位置からの最長の回文の長さを $O(|S|)$ で計算できるらしい。
[わりとよくある備忘録 回文検出(Manacher)](https://klee.hatenablog.jp/entry/2020/06/18/210754)
のコードを参考にした。

配列をまりまり使うアルゴリズムかと身構えるが、よく見ると、ランダムアクセスが必要なのは入力文字列Sの各文字だけで、
過去の判定結果は（生成と逆順に）順次アクセスできればそれでよい。

元コードを読み解いていく。まず準備の部分：
```cpp
string s = "abacababa";    // s : 入力文字列
int n = s.size();          // n : sの長さ

vector<int> rad(n);        // rad[i] : 文字s[i]を中心とする回文の半径
int c = 0, r = 0;          // c : s の各文字を中心にして順次計算するループ変数
                           // r : 調査する半径の開始値を伝える状態変数
```

シグネチャを決める。
```haskell
manacher :: BS.ByteString   -- s
         -> [Int]           -- 答え rad の内容
manacher s = ...
  where
    n1 = pred $ BS.length s -- nに相当
```

メインループは、`for`ではないところが特徴的：
```cpp
while (c < n) {            // s[0]からs[n-1]まで順にrad[c]を求めていく
  ...
}
```

ループ内の前半では、中心に据えた文字の両側に同じ文字が並ぶ個数を数える。
最初に違う文字が出現した（あるいはsを踏み越えた）値が、中心の文字を含めた半径の大きさとなる。
```cpp
    // cを中心に同じ文字がどこまで連続するか
    while (0 <= c - r && c + r < n && s[c - r] == s[c + r]) r++; // (A)
    rad[c] = r; // (B)
```

これを関数に括り出す：
```haskell
manacher s = spread [] 0 0
  where
    spread :: [Int] -- rs : rad[c-1,c-2,...,0] つまり求めたrad[]の内容の逆順、ここでは使わない
           -> Int   -- c : 現在の中心文字
           -> Int   -- r : カウント中の半径、インクリメントしていく
           -> [Int] -- 答え ここでは rad[c] を求め、さらに続きのradも求めていく
    spread rs c r
-- cがオーバーランしたら終了
      | n1 < c = []
-- 左右r文字離れたところが同じなら広げる 上の(A)の処理
      | 0 <= c - r, c + r <= n1, BS.index s (c - r) == BS.index s (c + r) = spread rs c (succ r)
-- 違う文字なら半径が求められた 上の(B)の処理
      | otherwise = r : ...
```

ループ内の後半では、`c`を中心に`r`文字先まで、
手前側と半径が等しい（かそれ以上である）ことがついでに確定したので、その結果を流用する。
ただし、`r`に届いているときはそれ以上か調べ直す必要があるので、そこで止める。
```cpp
    //回文の長さに応じて利用可能な範囲を確認しつつメモ
    int k = 1;
    while (0 <= c - k && k + rad[c - k] < r) { // (C)
      rad[c + k] = rad[c - k]; // (D)
      k++;
    }
```

これを関数に括り出す：
```haskell
    spread rs c r
      | otherwise = r : mirror (r:rs) r (succ c) 1 rs
    mirror :: [Int] -- rrs : rad[c-1,c-2,...,0] つまり求めたrad[]の内容の逆順、次のmirrorのために蓄積する
           -> Int   -- r0 : これを起動したspreadが求めたrの値
           -> Int   -- c0 : これを起動したspreadの中心文字
           -> Int   -- k : spreadから起動されてから何文字目かのカウント
           -> [Int] -- rs : rad[c-1,c-2,...] 前から消費する
           -> [Int] -- 答え ここでは rad[c0+k] を求め、さらに続きのradも求めていく
    mirror rrs r0 c0 k (r:rs)
-- ガードは(C) 0 <= c0 - k は、引数rsが空でないことから保証される
-- 右辺は(D)
      | k + r < r0 = r : mirror (r:rrs) r0 c0 (succ k) rs
```

ループの先頭に戻るときに、`c` が進められ、`r` は左側で数えた値から続けるように取り出される：
```cpp
//すでに計算が終わった分だけ中心と探索半径をずらす
    c += k;
    r -= k;
```

これは`mirror`から`spread`への呼び出しに写せる：
```haskell
    mirror rrs r0 c k _ = spread rrs (c0 + k) (r0 - k)
```

`mirror`の変数`k`は、元のプログラムとの対比のため残したが、
毎回 `c0`をインクリメント、`r0`をデクリメントすれば不要になる：
（ただし`spread`から呼び出す際の`r0`の初期値も`pred`しておく）

```haskell
    mirror rrs r0 c (r:rs)
      | r < r0 = r : mirror (r:rrs) (pred r0) (succ c) rs
    mirror rrs r0 c _ = spread rrs c r0
```

## Manacher（偶数直径込み）

直径が偶数になる、文字の間を中心とする回文も調べるには、元文字列にダミー文字を挟み、
それらを中心とする回文は元の文字列では偶数直径の回文に相当する、とやればよい。

参考ページの続きにある方法では、文字列の文字の間だけでなく先頭と末尾にもダミーを追加している。
これは一見無駄に思えるが、ダミー文字vs文字列終端、という例外的な場合を排除できるので、
こうした方がロジックが簡潔になる、番兵のような効果がある。

`spread` `mirror` の内部ロジックは上の計算そのままで、
結果を出力する部分にのみ、ダミー文字込みの半径から直径に変換（といっても `pred` をとるだけ）
するロジックを追加する。
また、ダミー文字列を挟んだ文字列はメモリ中に構築せず、
文字列のアクセサに細工をして実現する。

```haskell
manacher :: BS.ByteString -> [Int]
manacher s = tail $ spread [] 0 0 -- 先頭のダミー文字の結果を捨てる
  where
    n1 = 2 * BS.length s
    a i | odd  i    = BS.index s (div i 2) -- 文字列アクセサ
        | otherwise = '#'
    spread rs c r
      | c == n1 = [] -- 末尾のダミー文字について計算せずに終わらせる
      | 0 <= c - r, c + r <= n1, a (c - r) == a (c + r) = spread rs c (succ r)
      | otherwise = pred r : mirror (r:rs) (succ c) (pred r) rs
    mirror rrs c r0 (r:rs)
      | c == n1 = []
      | r < r0 = pred r : mirror (r:rrs) (succ c) (pred r0) rs
    mirror rrs c r0 _ = spread rrs c r0
```

## 問題への答え

問題の要求は、Sが `abc-xyzyx` のように末尾が回文になっているものの最長なものを求めて、
回文が始まる前の部分の反転 `cba` を作ることである。

`manacher` は、Sの各文字または文字と文字の間を中心とする回文の直径を順に返しているので、
その列の後ろから（1始まりで）第 k 要素が k であるものの最大値（はそのような先頭の値）を探し、
これを全長から引けば前半部の長さが得られる。

```haskell
abc398f :: BS.ByteString -> BS.ByteString
abc398f s = BS.reverse $ BS.take k s
  where
    len = BS.length s
    h = len + pred len
    (rr,_) = head $ filter (uncurry (==)) $ zip [h, pred h .. 1] $ manacher s
    k = len - rr
```

[提出](https://atcoder.jp/contests/abc398/submissions/64179252)

# G - Not Only Tree Game

[フレンズさんいわく](https://x.com/kyopro_friends/status/1903444389931667732)
> あとは頑張って考えるのだ……

あっこれ無理なやつです。