ABC401をHaskellで

# A - Status Code

[問題 ABC401A](https://atcoder.jp/contests/abc401/tasks/abc401_a)

シグネチャを決める。

```haskell
import Data.Bool

abc401a :: Int    -- S
        -> String -- 答え
abc401a s = bool "Failure" "Success" $ 200 <= s && s <= 299
```

## ずるいやり方

$100 \leq S \leq 999$ と桁数が一定なので、文字列のまま比較してもよいし、
入力の条件をさらに悪用すると、先頭が `2` であることを確認するだけでよい。

```haskell
abc401a :: String -- S
        -> String -- 答え
abc401a ('2':_) = "Success"
abc401a _       = "Failure"
```

# B - Unauthorized

[問題 ABC401B](https://atcoder.jp/contests/abc401/tasks/abc401_b)

シグネチャを決める。

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

検出するべきエラーは、`private` を受け取ったときに、
ログインして**いない**状態だった瞬間である。

## 結果

エラーの検出と回数のカウントを責務として分離する作り方が好き。
オートマトンの内部状態が、ログインしているかしていないか、だけにできる。

```haskell
import Data.List

abc401b :: Int -> [String] -> Int
abc401b _n ss = length $ filter id es
  where
    (_, es) = mapAccumL step True ss
    step _    "login" = (False, False)
    step _    "logout" = (True, False)
    step mode "public" = (mode, False)
    step mode "private" = (mode, mode)
```

エラー回数のカウントも内部状態に持たせれば、`mapAccumL` よりも小さい `foldl` でできる。

```haskell
import Data.List

abc401b :: Int -> [String] -> Int
abc401b _n ss = ans
  where
    (_, ans) = foldl step (True, 0) ss
    step (_   ,cnt) "login"  = (False, cnt)
    step (_   ,cnt) "logout"  = (True, cnt)
    step (True,cnt) "private" = (True, succ cnt)
    step mc         _         = mc  -- public, safe private
```

# C - K-bonacci

[問題 ABC401C](https://atcoder.jp/contests/abc401/tasks/abc401_c)

シグネチャを決める。

```haskell
abc401c :: Int -- N
        -> Int -- K
        -> Int -- 答え
```

## 考える

$A_K = A_0 + A_1 + \dots + A_{K-1} = 1 + 1 + \dots + 1 = K$ である。
$K < i$ のとき
$A_{i  } = A_{i  -K} + A_{i  -K+1} + \dots + A_{i  -1}$
$A_{i-1} = A_{i-1-K} + A_{i-1-K+1} + \dots + A_{i-1-1}$
差をとると
$A_{i} - A_{i-1} = A_{i-1} - A_{i-1-K}$

つまり、尺取法で直前の値を足し$K$個前の値を引くことで次の値が得られる。

```haskell
abc401c :: Int -> Int -> Int
abc401c n k = as !! n
  where
    as = replicate k 1 ++ maomao as k (drop k as)
    maomao (x:xs) acc (y:ys) = acc : maomao xs (mod (acc + y - x) (10^9)) ys
```

しかし動かない。
`maomao` の本体で `acc :` をしているから第K項も出るだろうに？と悩んでしまった。
等式が選択されるのはパターンマッチに成功してからなので、
`(drop k as)` というリストが `(y:ys)` というパターンにマッチする、
つまり `as` はここで空にならないことを先に保証しなければならない。

空にならないことがわかるように、先に値をリストに確定させておくと動くようになるが、`maomao` が少しダサくなる。

```haskell
    as = replicate k 1 ++ k : maomao as k (drop k as)
    maomao (x:xs) acc (y:ys) = acc1 : maomao xs acc1 ys
      where
        acc1 = mod (acc + y - x) (10^9)
```

パターンマッチで `(y:ys)` と分離することを諦めるやり方もある。

```haskell
    as = replicate k 1 ++ maomao as k (drop k as)
    maomao (x:xs) acc yys = acc : maomao xs (mod (acc + head yys - x) (10^9)) (tail yys)
```

しかしここで使う `y` とは、直前で出力した値、つまり `acc` と等しいことに気づくと、
`ys` 引数そのものをなくせる。

```haskell
    as = replicate k 1 ++ maomao as k
    maomao (x:xs) !acc = acc : maomao xs (mod (acc + acc - x) (10^9))
```

# D - Logical Filling

[問題 ABC401D](https://atcoder.jp/contests/abc401/tasks/abc401_d)

シグネチャを決める。Sが長いので `ByteString` を使う。

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

abc401d :: Int           -- N
        -> Int           -- K
        -> BS.ByteString -- S
        -> String        -- 答え
```

DPを使う問題？…ではなかった。

$S$ に既にある `o` の個数を $K$ から引き、`?` に置くべき `o` の個数 $J$ を考える。

規則から、`o` が隣にある `?` は `.` に必ずなる。これは前処理で消しておく。
次に、$k$ 個の連続する `?` について、最大でいくつの `o` を入れることができるか考える。
$k$ が奇数のとき、`o.o.o` のようになり、$\lfloor (k+1)/2 \rfloor$ 個入れられる。
$k$ が偶数のとき、`o.o.` または `.o.o` で、$k / 2 = \lfloor (k+1)/2 \rfloor$ 個入れられる。

$S$ を調べて、可能な `o` の最大を数えたとき、これが $J$ とちょうど等しいとき、
奇数個の連続にはどのように入れるか確定し、
偶数個の連続には二通りの入れ方があるので任意となる。

$J$ が可能な数より小さいとき、最大の入れ方からどれを外してもよいし、
奇数個の連続に対する入れ方も自由になるので、全てが任意となる。

$J=0$ の場合だけ特別で、`o` を入れる機会がないので全て `.` で確定する。

## 結果

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

abc401d :: Int -> Int -> BS.ByteString -> String
abc401d n k s
  | cnt0 == 0    = map g $ BS.unpack s -- そもそも?に置くoがないなら、?にならない。
  | cnt0 < avail = elems s1            -- 余裕がある場合はs1ママ
  | otherwise    = out $ elems s1      -- ぱっつんなので、奇数はぴっちり偶数は?で出す
  where
-- ?の中に置く必要のある 'o' の個数 J
    cnt0 = k - BS.count 'o' s
-- cnt0 == 0 の場合
    g '?' = '.'
    g c   = c

-- 前後に o がある ? は . で確定させる前処理
    bnds = (0, pred n)
    s1 :: UArray Int Char
    s1 = listArray bnds (BS.unpack s) //
         [ (j, '.')
         | i <- [0 .. pred n], 'o' == BS.index s i
         , j <- [pred i, succ i], inRange bnds j]
-- 連続する ? の長さを数えて、置ける o の最大個数を数える
    avail = sum $ map (flip div 2 . succ . length) $
            filter head $ group $ map ('?' ==) $ elems s1

-- ぱっつんの場合の出力を計算
    out "" = ""
    out cs
      | even l1   = cs1 ++ cs2 ++ out cs3
      | otherwise = take l1 ('o' : cycle ".o") ++ cs2 ++ out cs3
      where
        (cs1, cs23) = span ('?' ==) cs
        (cs2, cs3)  = span ('?' /=) cs23
        l1 = length cs1
```

[ユーザ解説 by seekworser](https://atcoder.jp/contests/abc401/editorial/12703) にDPでする方法も示されていた。
（実装例のC++コードはぱっと見短く見えるが、3行めに何やらライブラリが詰め込まれている。）

# E - Reachable Set

[問題 ABC401E](https://atcoder.jp/contests/abc401/tasks/abc401_e)

シグネチャを決める。

```haskell
abc401e :: Int     -- N
        -> Int     -- M
        -> [[Int]] -- u_i, v_i
        -> [Int]   -- 答え
```

目的の状態にするには、頂点 $k+1$ ～ $N$ のうち、
頂点1から頂点kまでのいずれかと辺を持つものを全て削除する必要がある。
ただしこうしたとき、頂点1からkまでが連結にならなかったら、その$k$については不可能と判定する。

$k=1$ のとき、条件は必ず満たすことができ、頂点1と隣接する頂点が消すべき対象である。この頂点集合を $S_k$ とする。
$S_1 = \\{ v \ |\ (1,v) \in E \\}$

$k=j$ について考えるとき、頂点1から$j$までからなる部分グラフが連結である必要がある。
（途中で一端切れてまた繋がるような場合を考えると、
$S_{j-1}$ が頂点 $j$ を含むことは条件を満たすための必要条件であるが十分条件ではない。）
条件は、Union-Findへ順に頂点を追加することで判定することができる。
$S_j$ は頂点 $j$ を除く必要があり、また
頂点 $j+1$ ～ $N$ のうち、頂点 $j$ と辺を持つようなものを全て追加で削除する必要がある。

$S_j = S_{j-1} \setminus \\{j\\} \cup \\{ v \ |\ (j,v) \in E \\}$

## 結果

immutableなUnion-Findで実装する。
$S_k$ を `IntSet` で表すとき、素朴に `IS.size` を使うと重いので、丁寧に数える。

```haskell
import Data.List
import Data.Array
import qualified Data.IntSet as IS
import qualified Data.IntMap as IM

abc401e :: Int -> Int -> [[Int]] -> [Int]
abc401e n _m uvs = ans
  where
-- 頂点 j から左向きの辺リスト
    ls = accumArray (flip (:)) [] (1,n) [(j,u) | u:j:_ <- uvs]
-- 頂点 j から右向きの辺リスト
    rs = accumArray (flip (:)) [] (1,n) [(j,v) | j:v:_ <- uvs]
-- j=1,...,Nまで順に、
-- 頂点jを追加した部分グラフが1から連結かどうかの判定と、Sjを計算する
    (_,ans) = mapAccumL step (newUF, IS.empty, 0) [1 .. n]
    step (uf, is, siz) j = ((uf1, is1, siz1), if cond then siz1 else (-1))
      where
        uf1 = foldl (\uf -> uniteUF uf j) uf (ls ! j)
        cond = j == snd (getRoot uf1 1)
        is1 = IS.union (IS.delete j is) (IS.fromList $ rs ! j)
        siz1 = siz - (if IS.member j is then 1 else 0) + length [() | v <- rs ! j, IS.notMember v is]

type UnionFind = IM.IntMap Int

newUF = IM.empty

-- 代表元と、分割の大きさの対を返す
getRoot :: UnionFind -> Int -> (Int, Int)
getRoot uf p =
  case IM.lookup p uf of
    Nothing -> (p, 1)
    Just q | q < 0 -> (p, negate q)
           | otherwise -> getRoot uf q

-- 統合する
uniteUF :: UnionFind -> Int -> Int -> UnionFind
uniteUF uf p q
  | a == b    = uf
  | s >= t    = IM.insert a (negate (s + t)) $ IM.insert b a uf
  | otherwise = IM.insert b (negate (s + t)) $ IM.insert a b uf
  where
    (a,s) = getRoot uf p
    (b,t) = getRoot uf q
```

[提出 AC 1156ms](https://atcoder.jp/contests/abc401/submissions/64925725) immutableなままで間に合う。
（STモナドでmutableに同じアルゴリズムを実装すると[414ms](https://atcoder.jp/contests/abc401/submissions/64822516)だけども。）

## 解説 by KumaTachiRen の方法

https://atcoder.jp/contests/abc401/editorial/12705
頂点1からkの範囲に収まる辺全てを使ったグラフの、
1を含む分割のサイズがkであることが条件、という、上と同じUnion-Findの使い方に加えて、
頂点1からkから生えている全ての辺を使ったグラフを考える。
これは $S_k \cup \\{1 ,\dots, k\\}$ に他ならないので、芯をくりぬけば求める大きさが得られるというからくり。

```haskell
abc401e :: Int -> Int -> [[Int]] -> [Int]
abc401e n _m uvs = ans
  where
-- 頂点 j から左向きの辺リスト
    ls = accumArray (flip (:)) [] (1,n) [(j,u) | u:j:_ <- uvs]
-- 頂点 j から右向きの辺リスト
    rs = accumArray (flip (:)) [] (1,n) [(j,v) | j:v:_ <- uvs]
-- j=1,...,Nまで順に、大きいUFと小さいUFの両方を更新し、
-- 小さい方で条件判定、大きい方でサイズを計算する
    (_,ans) = mapAccumL step (newUF, newUF) [1 .. n]
    step (uf_small, uf_large) k = ((uf_small1, uf_large1), if cond then siz else (-1))
      where
        uf_small1 = foldl (\uf -> uniteUF uf k) uf_small (ls ! k)
        cond = k == snd (getRoot uf_small1 1)
        uf_large1 = foldl (\uf -> uniteUF uf k) uf_large (ls ! k ++ rs ! k)
        siz = snd (getRoot uf_large1 1) - k
```

immutableなUnion-Findのままで[1966msとギリギリでACした。](https://atcoder.jp/contests/abc401/submissions/64927105)

## O(N+M) 時間解法 by shobonvip の方法

https://atcoder.jp/contests/abc401/editorial/12706
上記の解法は、頂点1からkまでからなる部分グラフを芯として考えたが、
これは、「頂点1からkまでからなる部分グラフにおいて、頂点1から到達可能な頂点集合」を $S_k$ として芯にすえて考える。
また、$S_k$ に隣接する頂点集合 $T_k$ も管理する。

$S_1 = \\{ 1 \\}, T_1 = \\{v \ |\ (1, v) \in E \\}$ である。

$k+1 \not\in S_k$ のとき、$k+1$ を経由してどこにも行けないので $S_{k+1} = S_k, T_{k+1} = T_k$ で、このとき条件を満たさない。

$k+1 \in S_k$ のとき、$k+1$ を経由してまた $j \leq k$ な頂点にも到達可能になる可能性がある。
このとき、$k+1$と隣接する$k$以下の頂点で、$S_k$ に含まれないものと、
そこからさらに$k$以下の頂点で到達できるものすべては、グラフの探索で発見できる。
これを $A_{k+1}$ とすると、$S_{k+1} = S_k \cup A_{k+1}$ となる。
$A_{k+1}$ に隣接する $k+1$ より大きい頂点の集合 $B_{k+1}$ も、$A_{k+1}$ の構築時に同時に収集できる。
そして $T_{k+1} = (T_k \setminus \\{k+1\\}) \cup B_{k+1}$ となる。
これらの計算は辺の本数だけ行うので、全体で $O(M)$ かかる。

前半の「$A_{k+1}$をDFSで探索する」と後半の「$B_{k+1}$ を発見する」がどちらも $O(M)$ で実行できるのはいずれも、$O(1)$で更新できる命令型配列によるフラグ配列が前提で、immutableな計算とは相性がよくない。

# F - Add One Edge 3

[問題 ABC401F](https://atcoder.jp/contests/abc401/tasks/abc401_f)

シグネチャを決める。

```haskell
abc401f :: Int     -- N1
        -> [[Int]] -- u_1,i, v_1,i
        -> Int     -- N2
        -> [[Int]] -- u_2,i, v_2,i
        -> Int     -- 答え
abc401f n1 uvs1 n2 uvs2 = ...
```

自分の考えた解法は、公式解説のやり方の、後半は二分探索なものだった。

## 自分の解法

### 前半

まず、両方の木を、いつものグラフ表現に直す。
`uvs1`, `uvs2` からそれを作る関数を立てる。

```haskell
import Data.Array.Unboxed

-- グラフの隣接リスト表現
type Graph = Array Int [Int]

-- グラフ配列を作る
gArray :: Int -> [[Int]] -> Graph
gArray n uvs = accumArray (flip (:)) [] (1,n) $ concat [[(u,v),(v,u)] | u:v:_ <- uvs]
```

この木に対して、直径の両端の頂点を特定し、
全ての頂点に対して、両者からの距離の大きい方を割り当てる。
ついでに、その最大値が直径になるのでその値も得ておく。

これをするには、まず任意の葉 `v1` を適当に選び、そこから最も遠い葉 `v2` を見つける。これが一端になる。
そこから最も遠い葉 `v3` がもう一端になる。

```haskell
import Data.Function

-- 木の各頂点から最も遠い頂点までの距離をそれぞれ求める 最大値たる直径もついでに返す
radDists :: Graph -> (Int, UArray Int Int)
radDists g = (rad, res)
  where
    v1 = head [v | (v,[_]) <- assocs g]
    (v2, _) = maximumBy (compare `on` snd) $ dfs v1 v1 (0 :: Int) []
    dfs p v d rest = (v, d) : foldr (\c -> dfs v c (succ d)) rest [c | c <- g ! v, c /= p]
    distV2 = array (bounds g) $ dfs v2 v2 0 []
    (v3, rad) = maximumBy (compare `on` snd) $ assocs distV2
    res = accum max distV2 $ dfs v3 v3 0 []
```

ちなみに、`dfs` の定義を横着して

```haskell
    dfs p v d = (v, d) : [vd | c <- g ! v, c /= p, vd <- dfs v c (succ d)]
```

のようにすると、`concat` が起きまくってTLEする。

ここまでを `abc401f` 本体から使っておく。

```haskell
abc401f :: Int -> [[Int]] -> Int -> [[Int]] -> Int
abc401f n1 uvs1 n2 uvs2 = ...
  where
    (r1, ds1) = radDists $ gArray n1 uvs1 -- 木1の直径、各頂点からの最大距離
    (r2, ds2) = radDists $ gArray n2 uvs2 -- 木2の (ry
    r12 = max r1 r2                       -- d1 + 1 + d2 より大きいかもしれない直径
```

### 後半

木1の頂点 $i$ 木2の頂点 $j$ を結んだ辺を通る最長の経路の長さは $ds1[i] + 1 + ds2[j]$ で、これが $r12$ 以下ならこちらを選ぶ。
一つの $ds1[i]$ の値に対して、$ds2[\cdot]$ の値を一括で処理したい。

$r12 < ds1[i] + 1 + ds2[j]$ すなわち $ds2[j] > r12 - 1 - ds1[i]$ である
$j$ の個数と、そのような $ds2[j]$ の総和を $ds1[i]$ に対して与える `IntMap` が必要である。
ある $i$ に対して個数が $cnt$、$ds2[j]$ の総和が $sum$ であるとき、$i$ に関する答えの値は
$cnt (ds1[i] + 1) + sum + (N2 - cnt) \cdot r12 = cnt (ds1[i] + 1 - r12) + sum + r12 \cdot N2$
と求められる。

キーとする値のリストが与えられたとき、そのキーに対して与えられた関数を適用したものを値とするマップを作り、
さらにそれを大きい方からの累積和に置き換えたマップを作る関数を用意する。

```haskell
import qualified Data.IntMap as IM

mkMap :: (Int -> Int) -> [Int] -> IM.IntMap Int
mkMap f xs = IM.fromDistinctAscList $ zip (IM.keys im0) $ scanr1 (+) $ IM.elems im0
  where
    im0 = IM.fromListWith (+) $ (maxBound, 0) : [(x, f x) | x <- xs]
```

関数として `const 1` を与えると個数、`id` を与えると値の累積和として使える。
そのように本体から使う。

```haskell
-- ds2の要素について、より大きい値の個数と、その値の総和を持つIntMap
    cntD2 = mkMap (const 1) $ elems ds2
    sumD2 = mkMap id        $ elems ds2
```

$ds1[i]$ のそれぞれの値に対して答えを求め、総和をとると答えになる。

```haskell
abc401f n1 uvs1 n2 uvs2 = sum
    [ n2 * r12 + c * (succ d1 - r12) + s
    | d1 <- elems ds1, let t = pred r12 - d1
    , let Just (_,c) = IM.lookupGT t cntD2
    , let Just (_,s) = IM.lookupGT t sumD2 ]
  where
    ...
```

## 別解について

前半の、各頂点からの最大距離を求める計算は、全方位木DPという技法が使えるとあるが、
それをマスターしていないのでよくわからない。

後半の、$ds1[i]$ に対する $cnt, sum$ を求める計算は、
$ds1[\cdot], ds2[\cdot]$ の両方をソートしてからとりかかると、
$ds1[i]$ が大きくなるにつれて $ds2[j]$ の境界は減少する一方であり、
二分探索で探す代わりに、大きい方から線形探索し、
次の $ds1[i+1]$ について探すときは続きからやることで、
全体で $O(N_1 N_2)$ でなく $O(N_2)$ だけで済む、という尺取法が使える。
順に舐めていくので累積和も同時に計算できてしまう。すごい。

後半をFFTを用いて求める別解が 解説 by shobonvip で述べられている。
しかし、AtCoder Library の convolution_ll は、
「素数で割った余りを求めない畳み込み」を求めている風ではあるが、
実のところ、「素数で割った余りを求める畳み込み」を複数の素数で行った結果から
中国剰余定理で真値を推測するという仕組みではなかったか。

# G - Push Simultaneously

[問題 ABC401G](https://atcoder.jp/contests/abc401/tasks/abc401_g)

シグネチャを決める。

```haskell
abc401g :: Int     -- N
        -> [[Int]] -- sx_i, sy_i
        -> [[Int]] -- gx_i, gy_i
        -> Double  -- 答え
```

わからないのでヒントをください。
[フレンズさんいわく](https://x.com/kyopro_friends/status/1911285161024770268)
> アライグマ「G問題は、答えを二分探索なのだ！
> 「t秒以内にできるか？」の判定問題を考えると二部マッチングになるのだ！」

## 二部マッチング

「二部マッチング」というキーワードで検索すると、蟻本がバイブルらしい。
手許にあるのは古い方だけど書いてあった。
ネットワークフローを計算する Dinic 法を応用するのだと。

さらに、二部マッチング問題の性質を利用したより簡潔なアルゴリズムが載っている。
これをスタート地点にしよう。

`//` は原文のコメント、`///` は自分が追加した解釈。

```c++
int V;                // 頂点数
vector<int> G[MAX_V]; // グラフの隣接リスト表現
int match[MAX_V];     // マッチングのペア
bool used[MAX_V];     // DFSですでに調べたかのフラグ

// uとvを結ぶ辺をグラフに追加する
void add_edge(int u, int v) {
  G[u].push_back(v);
  G[v].push_back(u);
}

// 増加パスをDFSで探す
bool dfs(int v) {
  used[v] = true;
  for (int i = 0; i < G[v].size(); i++) { /// v から生えている全ての辺について調べる
    int u = G[v][i], w = match[u];        /// u がもう一端、w がuが既にマッチしている相手
    if (w < 0 || !used[w] && dfs(w)) {    /// uはまだマッチしていない、または、usedでなく、再帰的にdfsした結果がtrueなら
      match[v] = u;                       /// vとuはマッチしたとして記録して
      match[u] = v;
      return true;                        /// 成功を返す
    }
  }
  return false;                           /// どの辺も失敗したなら失敗
}

// 二部グラフの最大マッチングを求める
int bipartite_matching() {
  int res = 0;
  memset(match, -1, sizeof(match));       /// match[]を-1に初期化
  for (int v = 0; v < V; v++) {           /// vを順に調べる
    if (match[v] < 0) {                   /// 以前のvによってマッチが決まっていないならする
      memset(used, 0, sizeof(used));      /// used[]を0に初期化
      if (dfs(v)) {                       /// dfsして、上手くいったら成功数を1増やす
        res++;
      }
    }
  }
  return res;
}
```

`match` に対応がとれた相手が保存される。初期値 `-1` のときはまだ対応がない。
`used` は `dfs()` を始めるたびにリセットされる。
`res` がインクリメントされるのは`bipartite_matching()`の中だけで、`v`ごとに一度しか機会はないので、漏れなくマッチがとれるかを判定する使い方のときは、一度でも失敗したらそこで終了にできる。

### 例題

drkenさんの記事の[最大二部マッチング問題の適用例](https://qiita.com/drken/items/e805e3f514acceb87602#%E6%9C%80%E5%A4%A7%E4%BA%8C%E9%83%A8%E3%83%9E%E3%83%83%E3%83%81%E3%83%B3%E3%82%B0%E5%95%8F%E9%A1%8C%E3%81%AE%E9%81%A9%E7%94%A8%E4%BE%8B)を解くプログラムで実装を試みる。

男1～10に番号1～10、女1～10に番号11～20を割り当てる。
上の `match`, `used` は大域的な状態で、`State` モナドを使うか持ち回すかする必要がある。
ここでは持ち回している。
`dfs`の引数2は`used`で、最初に起動するときに新規作成、フラグを立てるのは呼び出し側の責務。
ループで調べる`u`の候補を`oppo`で作るのも呼び出し側の仕事で、
このHaskell版の`dfs`は上のC++版の`dfs()`の`for`ループの部分だけに対応する。
ループが途中脱出を含むのでこんな形になってしまった。

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

-- テストデータ 添字は（男番号, 女番号）
g :: Array (Int, Int) Bool
g = listArray ((1,11),(10,20)) $ map ('1' ==) $
  "1001000010" ++
  "0001001000" ++
  "0100010001" ++
  "0001000000" ++
  "0010010001" ++
  "1000100100" ++
  "0001001000" ++
  "1010000010" ++
  "0100100000" ++
  "0001000000"

type Match = IM.IntMap Int
type Used  = IS.IntSet

findMatch = foldl step IM.empty [1 .. 20] -- 全参加者について処理、dfsでmatchの更新を試みる
  where
    step match v
      | IM.member v match = match -- マッチが決まっていたらやることなし
      | otherwise         = finalize $ dfs match (IS.singleton v) v (oppo v) -- dfsした最終結果のmatchを返す
    finalize (_,m,_) = m
    oppo v -- v に隣接する頂点リストを g から作る
      | v <= 10   = [u | u <- [11 .. 20], g ! (v,u)]
      | otherwise = [u | u <- [ 1 .. 10], g ! (u,v)]
    dfs :: Match -> Used -> Int -> [Int] -> (Bool, Match, Used)
    dfs match used _v []  = (False,match,used)
    dfs match used v (u:us)
      | IM.notMember u match = (True, adduv match, used)
      | IS.member w used     = dfs match used v us
      | succeeded            = (True, adduv match1, used1)
      | otherwise            = dfs match1 used1 v us
      where
        adduv = IM.insert u v . IM.insert v u
        w = match IM.! u
        (succeeded, match1, used1) = dfs match (IS.insert w used) w (oppo w)
```

これをいじくることで、さらにいくつかの性質が見えてきた。

- `v`,`w` に入る頂点は左側、`u` に入る頂点は右側のものだけ
- 頂点が分離されているなら`bipartite_matching()`のループは左側の頂点だけやればよい。
  - つまり `foldl` は `[1 .. 10]` で十分。
  - `oppo` も引数は男だけ、結果は女だけ。場合分け不要。

## 二分探索

ある距離を上限とし、高橋くんからボタンまでの距離が上限以下のものはマッチできるというグラフについて、
二部マッチングが完成するかを判断する二分探索を行う。
高橋くんからボタンまでの距離の最小は1、最大は $\sqrt{2} \times 10^{18}$ となる。
この範囲の実数で二分探索し、反復の差分が $10^{-6}$ 以下になったところで止めれば題意を満たせる。

しかし、任意の距離で調べる必要はなく、答えになる可能性のある距離は、
高橋くんからボタンまでの距離 $N^2$ とおりのうちのいずれかである。
なので、それら最大 $300^2$ とおりの場合だけ離散的に試す二分探索で足りるし、厳密解が得られる。

距離を計算するために、座標成分ごとの差の二乗を計算する。
$10^{18}$ はぎりぎり `Int` に収まるが、その二乗はあふれる。
ここで `Integer` を使う選択肢もあるが、早めに `Double` に変換してしまうことにする。
ただし、二分探索の間は距離の二乗のままで進めて、最後に答えだけ平方根をとる。

## 結果

immutableな二部マッチングのままで試したもの：[TLEx12](https://atcoder.jp/contests/abc401/submissions/64904086)
二部マッチングの計算を `ST` モナドでmutableに実装したもの[AC, 821ms, 36MB](https://atcoder.jp/contests/abc401/submissions/64905871)