ABC292 A～F をHaskellで

# A - CAPS LOCK

[問題 ABC292A](https://atcoder.jp/contests/abc292/tasks/abc292_a)

`Data.Char.toUpper` を使えばよい。

## 結果

```haskell
import Data.Char

main = getLine >>= putStrLn . map toUpper
```

# B - Yellow and Red Card

[問題 ABC292B](https://atcoder.jp/contests/abc292/tasks/abc292_b)

$Q \leq 100$ と規模は小さいので、`Data.IntMap`でイエローカードの枚数相当を覚えていけばことは足りる。
クエリ型だが、バッチでデータを受け取って一度に処理する。出力を行ったり行わなかったりなので、再帰関数で書き捨てる。

シグネチャを決める。イベントの型は手抜きする。

```haskell
abc292b :: Int     -- N
        -> Int     -- Q
        -> [[Int]] -- eventi
        -> [Bool]  -- 答え
```

## 結果

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

abc292b :: Int -> Int -> [[Int]] -> [Bool]
abc292b n q qs = loop IM.empty qs
 
loop _ [] = []
-- xのイエローカードを1枚増やす
loop m ([1,x]:qs) = loop (IM.insertWith (+) x 1 m) qs
-- xにイエローカード2枚持たせる
loop m ([2,x]:qs) = loop (IM.insert x 2 m) qs
-- xのイエローカードが2枚以上か調べる
loop m ([3,x]:qs) = maybe False (2 <=) (IM.lookup x m) : loop m qs
```

# C - Four Variables

[問題 ABC292C](https://atcoder.jp/contests/abc292/tasks/abc292_c)

書くまでもない感じだが、シグネチャを決める。

```haskell
abc292c :: Int  -- N
        -> Int  -- 答え
```

## 思いついた解法

つまり、ある整数 $X$ を二つの整数の積で表す方法（$a,b$と$b,a$は別に数える）が $f(X)$ とおりあるとき、$f(X) \times f(N-X)$ を $1 \leq X \leq N-1$ について求めた総和が答え。
この関数 $f(X)$ は $X$ の約数の個数なので、試し割りで約数を列挙する作り置き関数を使って計算できる。

```haskell
abc292c n = sum $ zipWith (*) fs $ reverse fs
  where
    f = length . factors
    fs = map f [1 .. pred n]

-- @gotoki_no_joe
factors :: Int -> [Int]
factors 1 = [1]
factors n = 1 : loop 2 [n]
  where
    loop k us
      | k2 >  n =     us
      | k2 == n = k : us
      | r  == 0 = k : next (q:us)
      | True    =     next    us
      where
        (q,r) = divMod n k
        next = loop (succ k)
        k2 = k * k
```

別のやり方として、素因数分解で $X=\prod p_i^{e_i}$ となるとき、$f(X) = \prod (e_i+1)$ でやる方が早く収束しそう。しかしそれを試す必要はない。↓の方が賢い。

## 解説にあった、もう少し賢いやり方

エラトステネスの篩では、素数に遭遇したとき、その倍数を単に「素数でない」とフラグを立てて終わりにする。
同じような感じで、全ての整数 $1 \leq x < N$ に対して、その倍数 $x, 2x, 3x, \dots$ に「お前は $x$ を約数として持つ」とカウントした結果が、それぞれの数の約数の個数になる。これだと除算を使わないし、愚直に除算で約数を見つけるよりも繰り返し回数が少なくて済む。

```haskell
import Data.Array.Unboxed
 
abc292c :: Int -> Int
abc292c n = sum [fcnts ! i * fcnts ! (n-i) | i <- [1 .. n1]]
  where
    n1 = pred n
    fcnts :: UArray Int Int
    fcnts = accumArray (+) 0 (1, n1)
            [(kx, 1) | x <- [1 .. n1], kx <- [x, x+x .. n1]]
```

この解法で $O(N \log N)$ 、解説にはさらに[O(N)で解く方法も示されていた](https://atcoder.jp/contests/abc292/editorial/5912)が、お腹いっぱいです。

# D - Unicyclic Components

[問題 ABC292D](https://atcoder.jp/contests/abc292/tasks/abc292_d)

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

```haskell
abc292d :: Int      -- N
        -> Int      -- M
        -> [[Int]]  -- ui, vi
        -> Bool     -- 答え
```

連結成分はUnion-Findで求めることができる。分割の要素数を数えられる版が便利。（だが、必須ではなかった。）
これで各分割を代表する頂点を選出したら、それぞれの辺について、端点が所属する分割の代表頂点に対応付けて、辺の本数をカウントする。
全ての分割について、要素数と、数えた辺の本数が一致するかが答え。

## 結果

```haskell
import qualified Data.IntMap as IM

abc292d :: Int -> Int -> [[Int]] -> Bool
abc292d n m uvs = roots == edges
  where
    uf = foldl' step newUF uvs
    step uf (u:v:_) = uniteUF uf u v
    roots = IM.fromList [getRoot uf i | i <- [1..n]]
    edges = IM.fromListWith (+) [(fst $ getRoot uf u, 1) | u:v:_ <- uvs]

-- @gotoki_no_joe
type UnionFind = IM.IntMap Int

-- 以下シグネチャのみ、実装略
-- 空のUnion-Findを作る
newUF :: UnionFind
-- 代表元と属する分割の要素数のペアを返す
getRoot :: UnionFind -> Int -> (Int, Int)
-- 二つの要素の属している分割を統合する
uniteUF :: UnionFind -> Int -> Int -> UnionFind
```

`getRoot`が分割の要素数を返さない場合は、分割の要素数も愚直に数えればよい。
代表頂点番号だけを返すとして、次のようにできる。

```haskell
roots = IM.fromListWith (+) [(getRoot uf u, 1) | u <- [1 .. n]]
```

ここで、「頂点番号に対するIntMapの値が負の頂点が代表頂点で、負の値が分割の要素数となっている」という実装の裏側を悪用すると、

```haskell
roots = IM.fromAscList [(u, -c) | (u,c) <- IM.assocs uf, c < 0]
```

とできそうだが、「一度も話題に上らなかった頂点」についてこのIntMapは何も持たない仕様なので、これは誤りとなる。完成したデータ構造は、提供されたAPIだけを通して触りましょう。

このimmutableな実装は[1113ms, 148MB](https://atcoder.jp/contests/abc292/submissions/39447700)かかる。Union-Findをmutable arrayによる実装に置き換えるまでもなく間に合う。

# E - Transitivity

[問題 ABC292E](https://atcoder.jp/contests/abc292/tasks/abc292_e)

シグネチャを決める。$u_i, v_i$ は手抜きする。というかこれ入力は問題Dと同じ。

```haskell
abc292e :: Int      -- N
        -> Int      -- M
        -> [[Int]]  -- ui, vi
        -> Int      -- 答え
```

全ての頂点について、（自分を含めて）有向辺で到達できる頂点の個数を数える。これは頂点ごとにBFSで$O(N)$でできる。
つまりこれら全てに対して直接の辺が欲しいというのだから、それらの総和をとる。
しかしそれだと、元々ある$M$本の辺まで数えているので、これを引く。
あと、BFSの都合で、自己辺まで数えているので、$N$を引く。

## 結果

例3のように循環を含みうるので、遅延配列で求める、という技は使えない。

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

abc292e :: Int -> Int -> [[Int]] -> Int
abc292e n m uvs = sum (map bfs [1..n]) - n - m
  where
-- いつもの、グラフの辺を集める配列、ただし有向辺
    g = accumArray (flip (:)) [] (1,n) [(u,v) | u:v:_ <- uvs]

-- STモナドでmutable arrayを使って、kから到達できるノード数を数える
    bfs k = runST $ do
      arr <- newArray (1,n) False
      loop 0 arr [k] []

-- cnt : 数えた個数
-- arr : 到達済みかの表
-- xs  : 調べる頂点
-- ys  : xsが終わったら次にやる頂点
    loop :: Int -> STArray s Int Bool -> [Int] -> [Int] -> ST s Int
    loop cnt arr (x:xs) ys = do
      b <- readArray arr x
      if b then loop cnt arr xs ys else do
        writeArray arr x True
        loop (succ cnt) arr xs (g ! x ++ ys)
    loop cnt _   [] [] = return cnt
    loop cnt arr [] ys = loop cnt arr ys []
```

（DFSでも別によかったなこれ。距離を数える訳ではないから。）

# F - Regular Triangle Inside a Rectangle

[問題 ABC292F](https://atcoder.jp/contests/abc292/tasks/abc292_f)

シグネチャを決める。$A,B$ をわざわざ整数で受け取る必然性はない。`read`が勝手に`Double`で返してくれる。

```haskell
abc292f :: Double  -- A
        -> Double  -- B
        -> Double  -- 答え
```

$A \leq B$ とする。幅 $A$ 高さ $B$ の箱の中に、辺の長さ $L$ の正三角形を落として、中に納まるかを考える。キツキツにはまったのなら、三角形の左下の角が箱の左下の角に当たっている形になるはず。
$L < A$なら、単に三角形は箱の底に落ちている。もっと大きな三角形でも行けるはず。$L = A$のとき、右の角も箱の右下に届いて、平らに落ちるいっぱいいっぱいの大きさになる。
このとき、三角形の上の角は底から高さ $\frac{\sqrt 3}{2}A < A$の位置にある。$A \leq B$を仮定しているので、これが箱の上に飛び出してしまうことはない。

もっと長い$L > A$でもいけるとき、まず三角形の底辺だけ箱に落とす。すると、横幅に収まらないので斜めにひっかかる。左下角は重なるとして、傾きは $L \cos t = A$ を満たす $t$ になるので、$t = \cos^{-1} \frac{A}{L}$ となる。
このとき、左の斜辺は、底辺から $t + 60^\circ$ の向きになるが、これが$90^\circ$を超えると、三角形が箱にめり込んでしまう、つまり傾きが大きすぎて入らない。つまり $t \leq 30^\circ$ が制約。
このとき、三角形の上の角の底からの高さは $L \sin (t + 60^\circ)$ で、これがやはり $B$ 以下になっていないとはみ出す。
以上をまとめると、辺の長さ $L$ の正三角形が$A \times B$の箱に収まる条件は：
$L \sin (t + 60^\circ) \leq B$ であること、ここで $t = \cos^{-1} (\max(1, \frac{A}{L})), t \leq 30^\circ$
となる。

このような条件を満たす $L$ を、二分探索で探せばよい。
浮動小数点数に対する二分探索は、ループを回るたびに精度が1ビット高まると考えられるので、仮数部のビット数だけ回れば十分。（富豪的）
探索の初期範囲は適当でいいが、下限は$A$、上限は$t=30^\circ$となる$\frac{2}{\sqrt 3}A$ と $B$ の小さい方、が限界か。下限を$A$にとると、上の $\max(1,\cdot)$が不要になる。

## 結果

```haskell
abc292f :: Double -> Double -> Double
abc292f a0 b0 = l
  where
    a = min a0 b0
    b = max a0 b0
    l = binsearch f a (a * 2 / sqrt 3)
    f l = t <= pi / 6 && l * sin (t + pi / 3) <= b
      where
        t = acos (a / l)

binsearch f l h = loop 99 l h
  where
    loop 0 l _ = l
    loop c l h
      | f m  = loop (pred c) m h
      | True = loop (pred c) l m
      where
        m = (l + h) / 2
```

…と、さもわかっている風に書いたが、自分でやったら式がこんがらがって中途半端にWAしてしまい、解説を見た。