ABC293 A～F をHaskellで

# A - Swap Odd and Even

[問題 ABC293A](https://atcoder.jp/contests/abc293/tasks/abc293_a)

ようは、1文字めと2文字目、3文字めと4文字め、…を入れ替える。

## 結果

Sの長さは偶数なので、文字が余る心配もしなくていい。

```haskell
main = getLine >>= putStrLn . abc293a

abc293a :: String -> String
abc293a (a:b:xs) = b : a : abc293a xs
abc293a "" = ""
```

`Data.List.Split` を駆使して `concat . map reverse . chunksOf 2` とできないこともない。

# B - Call the ID Number

[問題 ABC293B](https://atcoder.jp/contests/abc293/tasks/abc293_b)

シグネチャを決める。

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

「もう呼ばれた」かどうかのフラグを配列などで保持して、1から順に、まだ呼ばれていなかったら、その人が呼ぶ行動を行う、記述通りのシミュレーションを行う。

## 結果

ここでは `Data.IntSet` を用いて、「まだ呼ばれていない」番号を保持する。

```haskell
import qualified Data.IntSet as IS

abc293b :: Int -> [Int] -> [Int]
abc293b n as = IS.elems final
  where
    initial = IS.fromAscList [1..n]
    final = foldl step initial $ zip [1..] as
    step is (i,a)
      | IS.member i is = IS.delete a is
      | otherwise      = is
```

# C - Make Takahashi Happy

[問題 ABC293C](https://atcoder.jp/contests/abc293/tasks/abc293_c)

シグネチャを決める。

```haskell
abc293c :: Int      -- H
        -> Int      -- W
        -> [[Int]]  -- Aij
        -> Int      -- 答え
```

$H,W \leq 10$ とごく小さいので、それぞれのマスに到達するそれぞれの経路における遭遇した数の集合をリストで保持する。ただし、数が重複した経路は捨てる。

## 結果

定番の遅延配列DPをする。

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

abc293c :: Int -> Int -> [[Int]] -> Int
abc293c h w ass = length $ arr ! (h,w)
  where
    arr = array ((1,1),(h,w))
      [ ((i, j), f i j a)
      | (i, as) <- zip i ass
      , (j, a ) <- zip j as
      ]
    f 1 1 a = [IS.singleton a]
    f i j a = [IS.insert a s | s <- us ++ ls, IS.notMember a s]
      where
        us = if i == 1 then [] else arr ! (pred i, j)  -- 上隣
        ls = if j == 1 then [] else arr ! (i, pred j)  -- 左隣
```

# D - Tying Rope

[問題 ABC293D](https://atcoder.jp/contests/abc293/tasks/abc293_d)

個々のロープの端は、結び方の指示書の中で、二度出現することはないと保証されている。
つまり、一直線になるか、輪になるかのどちらかしかなく、枝分かれしたり、8の字やQの字や日や中の字のようになったりする心配はない、

ということは、端の色を気にする必要もなく、どことどこが繋がったかをUnionFindで追跡し、新たに連結されたなら伸びる、既に繋がっているところどうしで結ぶとは、輪をつくることと解釈するだけで答えは求められる。

最初、バラバラのロープN本がそれぞれで、輪になっていないつながりN個をなしている。
環状の個数は初期値0で、輪を作る結びのたびにカウントアップする。
線状の個数は初期値Nで、輪を作らない結びでは2本が1本に減るのでカウントダウンし、輪をつくる結びでは1本が無くなるのでやはりカウントダウンする。つまり最終的に $N-M$ になる。

と考察したところでシグネチャを決める。つまり色は無視する。

```haskell
abc293d :: Int          -- N
        -> Int          -- M
        -> [(Int,Int)]  -- Ai, Ci
        -> (Int, Int)   -- 答え
```

## 結果

`foldl`の更新する状態は、Union-Findと環状の個数の対。

```haskell
abc293d n m acs = [cntO, n - m]
  where
    (_, cntO) = foldl step (newUF, 0) acs
    step (uf, cntO) (a,c) =
      case uniteUF uf a c of
        Nothing  -> (uf , succ cntO)
        Just uf1 -> (uf1,      cntO)

-- Union-Findは省略
```

# E - Geometric Progression

[問題 ABC293E](https://atcoder.jp/contests/abc293/tasks/abc293_e)

シグネチャを決める。

```haskell
abc293e :: Int -- A
        -> Int -- X
        -> Int -- M
        -> Int -- 答え
```

「割った余り」なので合同算術を用いて、等比数列の和なので

$$\sum_{i=0}^{X-1} A^i = \frac{A^X - 1}{A - 1}$$

この除算はモジュロ逆数を用い…るためには、$A-1$と$M$が互いに素であることが必要だが、そんなことの保証はないので詰んだ。

## ナイーブなコード

多倍長整数（というのは普通、128ビット整数のことではなく、任意長の整数のことだよね）を振り回して、上の計算を直接やってみる。

```haskell
abc293e :: Integer -> Integer -> Integer -> Integer
abc293e a x m = mod (div (pred $ a^x) (pred a)) m
```

コードテストで例3を動かすと、メモリも900MB使って10秒でタイムアウトするので、提出するのはやめておこう。

## 倍々ゲーム的な解法

自分が解いたやり方。
（公式にある、[Xが奇数のとき, 後ろから削る解法 by Kazu1998k](https://kazun-kyopro.hatenablog.com/entry/ABC/293/E)と同じ方法）

$S_k = 1 + A + A^2 + \dots + A^{k-1}$ とする。これに$A^k$を掛けると  
$A^k S_k = A^k + A^{k+1} + A^{k+2} + \dots + A^{2k-1}$ 前の式と足すと
$S_k + A^kS_k = 1 + A + \dots + A^{k-1} + A^k + \dots + A^{2k-1} = S_{2k}$  
これで、項の数を倍にできる。
さらにこれに $A^{2k}$ を加えると
$S_{2k} + A^{2k} = 1 + A + \dots + A^{k-1} + A^k + \dots + A^{2k-1} + A^{2k} = S_{2k+1}$
項が1つ増える（当たり前）。

これらを逆向きにする。つまり、今 $S_X$ を求めたいとき、同時に $A^X$ も求めて、

- $X=1$ なら $S_1 = 1, A^X = A^1 = A$
- $X$ が偶数 $X = 2Y$ なら、$S_Y$ と $A^Y$ を求めて、$S_X = S_{2Y} = S_Y + S_Y \cdot A^Y, A^X = A^{2Y} = (A^Y)^2$
- $X$ が奇数 $X = 2Y+1$ なら、$S_Y$ と $A^Y$ を求めて、$A^{2Y} = (A^Y)^2$ としておいて $S_X = S_{2Y+1} = S_{2Y} + A^{2Y}, A^X = A \cdot A^{2Y}$

と再帰で計算できる。（上述のように、$A^X$を独立に繰り返し二乗法で計算する必要はないので、$O(\log X)$で済んでいると思う。）

```haskell
abc293e :: Int -> Int -> Int -> Int
abc293e a x m = fst $ recur x
  where
    mul x y = mod (x * y) m
    add x y = mod (x + y) m
    recur :: Int -> (Int, Int)  -- S_X と A^X の対を返す
    recur 1 = (1, a)
    recur x
      | r == 0 = (sx, ax)
      | True   = (add sx ax, mul a ax)
      where
        (y,r) = divMod x 2
        (sy,ay) = recur y
        sx = add sy (mul sy ay)
        ax = mul ay ay
```

ところが testcase06, testcase07 が牙をむく。
問題の制約「$1 \leq M$」が曲者で、$M=1$のときは$A,X$が何だろうと答えは0にしかならないが、さらに$X=1$のときは再帰の中でモジュロをとる機会もなく、基底の1がいきなり外に出てくるのがまずい。

これを回避するにはもう、$M=1$ のとき余計な計算を全回避する

```haskell
abc293e _ _ 1 = 0
```

という等式で握りつぶしてしまうか、ほとんどの場合に意味不明な基底の値を

```haskell
    recur 1 = (mod 1 m, a)
```

と設定するかのいずれかで解決できる。

## なんか賢い解法

[ユーザ解説 by kyopro_friends](https://atcoder.jp/contests/abc293/editorial/5966)の方法。

最初に挫折した、$M$を底にした合同算術による直接計算では、$A-1$と$M$が互いに素であることを保証できないため割り算ができない問題、合同算術の底を $M(A-1)$ にとることで、$A-1$による除算を普通の除算で計算してよくなるらしい。

ただし、$A, M \leq 10^9$ ということは $M(A-1) \leq 10^{18}$ で64bit整数ギリギリで、`mul` で計算する側の値はとっくにオーバーフローしている。「繰り返し**二倍**法」がわからないので、安直にIntegerで計算する。といっても、毎回剰余を取るので、ナイーブなやり方のように爆発するようなことはない。

```haskell
abc293e a0 x0 m0 = fromIntegral $ mod (div (pred $ powerish mul 1 a x) (pred a)) m
  where
    [a,x,m] = map fromIntegral [a0,x0,m0]
    mul x y = mod (x * y) (m * pred a)

-- @gotoki_no_joe
powerish mul i a b = foldl mul i [p | (True, p) <- zip bs ps]
  where
    bs = map odd $ takeWhile (0 <) $ iterate (flip div 2) b
    ps = iterate (\x -> mul x x) a
```

Pythonのべき乗関数など、オプションの第３引数でモジュロの底も指定できるというチートっぷりなら、`powerish` すら作らなくていい。

ただし、等比数列の和の公式が使える条件である「公比が1でないこと」を無視しているので、$A=1$の場合を例外処理しないと0除算でREする。そこで、次の等式を追加する。

```haskell
abc293e 1 x m = mod x m
```

after_contestは、$A-1$で割って終わりではなく、それをさらに$M$での剰余をとらないといけない、というのを忘れていてもACしてしまうテストケースしかなかったことを補完しているようだ。

# F - Zero or One

[問題 ABC293F](https://atcoder.jp/contests/abc293/tasks/abc293_f)

（あまりこういう側面から分析するのはよろしくないのだが）「同じ問題の異なるテストケースが一度に複数与えられる」スタイルの出題のとき、

- （正しい解法だと）計算量が少なすぎる内容なので、平均的な問題の制限時間に合わせるために出題数で嵩を増している
- 複数の問題の間で共通に使えるテーブルを、場合によっては問題の入力も利用して構築することで、計算量をシェアすることが問題の本質

のどちらなのか、見極める必要があることもある。

この問題に関して、「サイズNのDP配列に、それぞれの整数を表せるbの個数、またはその補助情報を持つ配列を構築して、これを利用して個々の問題に答える」スタイルなのかと考えた。が、$N \leq 10^{18}$ という巨大な配列が作れるはずもないので無駄足だった。

結果的に、個々の問題は独立しているようなので、そのようにシグネチャを決める。

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

b=2のとき、2進表示は0と1しか使えないので必ず条件を満たす。
b=Nのとき、N進表示でNとは"10"なので必ず条件を満たす。
$2 \leq N \leq 10^{18}$という広大な範囲で、条件を満たす基数bを数え上げるには、その存在範囲をうまく絞り込む必要がある。

## 一つの正攻法

自分が解いたやり方。
[公式解説 by leaf1415](https://atcoder.jp/contests/abc293/editorial/5945)のアイデアに沿っていると思う。

Nをb進数表示したとき、それが何桁になるか、を気にして考える。
$2 \leq N$なので、$b > N$進表示で1桁になるがそれは決して1にはならない。
条件を満たすような2桁になるのは$b = N, N-1$のときで、それぞれ "10", "11" となる。
2進表示にしたときに桁数は最大になる。
$10^{18}$は2進で60桁になるので、2～60の範囲を考えればよい。

b進法k桁で、数字には0と1だけ使って表せる数の最小値は "100...00" = $b^{k-1}$ である。最大値は "111...11" = $\sum_{i=0}^{k-1} b^i = (b^k-1)/(b-1)$ である。
N,kを固定して、これらがNと等しくなるとき、そのようなbは"11..11"のときが最小、"100..00"のときが最大になる。
つまり、Nとkが与えられたとき、Nをb進表示k桁で条件を満たして表せる可能性のあるbの範囲は、下限と上限を二分探索することで求めることができる。

```haskell
sub :: Int -> Int -> IS.IntSet
sub n k = IS.fromAscList [bl .. bh]
  where
    (_,bl) = binarySearch prop1 (succ n) 2
    prop1 b = (b^k - 1) <= n * (pred b)     -- b^k - 1 ≦ n (b - 1)
    (_,bh) = binarySearch prop2 2 (succ n)
    prop2 b = b ^ pred k >= n               -- b^(k-1) ≧ n

{- 二分探索
条件 prop を範囲の端 sat が満たし、反対の端 unsat が満たさないとき、
|a - b| = 1 となる (a,b) で、prop a = False, prop b = True となる境界を探す
-}
binarySearch :: (Int -> Bool) -> Int -> Int -> (Int, Int)
binarySearch prop unsat sat = ... -- 定義略
```

なお実際には、$b^k$などの計算があっさり`Int`の限界を超えるので、適宜`Integer`に変換して行う。

この `sub n k` を、kを2から60まで振ってその結果を集め、それらについて、本当に条件を満たすものを抽出して数える。

```haskell
-- 関数トップ
abc293f n = length [() | b <- IS.elems is, isValid b n]
  where
    is = IS.unions $ map (sub n) [2..60]

-- b進表示が全て0または1か
isValid b n = all (2 >) $ toBase b n

-- 数をb進表示にする。ただし下位が先に来る
toBase _ 0 = []
toBase b n = let (q,r) = divMod n b in r : loop q
```

結果は [2340ms, 5MB でAC](https://atcoder.jp/contests/abc293/submissions/39682649)

理論的な計算量は、一つの桁数について二分探索を行うのに $O(\log N)$で、桁数をここでは60に固定して説明したが、これも二進表記の桁数とすれば $\log N$なので、結局、$O((\log N)^2)$ だろうか。小さく見えるが、いつもより$N$が大きい。

## 現実主義者の解答（？）

上の解は制限時間的には間に合ってはいるものの、もう少し早くできる方法がありそうな気がして、他の人のAC解答を読んでみた。結果的にそれは公式にある [別解 by yuto1115](https://atcoder.jp/contests/abc293/editorial/5949) の系統だった。

0と1だけの並びを見ると、それはまるで2進数のように見える。つまり、2進数を数え上げることで、それを全て作ることができる。
そのような01の並びが一つ決まったとき、これがNをちょうど表す基数bが、あるならどのあたりなのかは、やはり二分探索で発見できる。そして見つけたbで本当に条件を満たすことができるかは、上の `isValid` で確認できる。この操作は一つの01の並びにつき $O(\log N)$ かかる。

では、2進数の数え上げで01の並びを全て作ると、何桁まで作ればよいだろうか。$N \leq 10^{18}$なので、これを網羅するには60桁が必要である。はい無理。

ここで諦めず、このアプローチが実用できる場面を考える。つまり、b進表記したときの桁があまり大きくならない範囲である。それは、bの値が大きい場合である。bが大きい範囲では特に条件を満たすものがまばらにしか存在しないので、そこを高速に処理できるのは意味がある。
対して、bが小さい範囲では、直に `isValid` を使って確認しても構わない、と考える。

最大の$N = 10^{18}$について、$c$桁を2進数の数え上げ法で行ったとき、それはどこまでのbの範囲をカバーするだろうか。$\log_b N = c, b^c = N, b = \sqrt[c]{N}$ となって

| c | b |
|--:|--:|
| 2 | 10^9 |
| 3 | 10^6 |
| 6 | 1000 |
| 8 | 178 |
| 9 | 100 |
| 18 | 10 |

$c=6$ とすると1～63で振って、$2 \leq b \leq 1000$ について総当たりと、バランスがよさそう。

整数xを二進表記で01と並びとみなして、それをb進数として解釈した値を求める関数を作る。
ただし、途中でIntがオーバーフローする前に切り上げてmaxBoundを返す。

```haskell
readAs :: Int -> Int -> Int
readAs b x = step1 x 1 0
  where
    plim = div maxBound b
    step1 x p acc
      | odd x     = step2 (div x 2) p (acc + p)
      | otherwise = step2 (div x 2) p acc
    step2 x p acc
      | x == 0    = acc
      | plim < p  = maxBound
      | otherwise = step1 x (p * b) acc
```

なんだか奇妙な実装になっているが、これをいつものように素直に書くと、オーバーフローぎりぎりのところで持ちこたえずにバグる。

```haskell
-- 素直でダメな版
readAs :: Int -> Int -> Int
readAs b x = loop x 1 0
  where
    plim = div maxBound b
    loop x p acc
      | x == 0    = acc
      | plim < p  = maxBound
      | odd x     = loop (div x 2) (p * b) (acc + p)
      | otherwise = loop (div x 2) (p * b)  acc
```
`x = 1` つまり今回 `acc + p` をしたらそれで完了という状況で、既に `plim < p` だと打ち切りにあってしまう。かといってこの条件を `maxBound < p` としたらそれは無意味。`plim = 10^18` としても、bがその値に近くなるので、検出する間もなく `p*b` はオーバーフローする。
xに関して計算をして、完了ならループを抜ける処理と、pに関して計算をして、無理ならループを抜ける処理のタイミングを分ける必要が、先のコードの理由である。

b=1000までを直接検査する部分と組み合わせれば完成。

```haskell
abc293f n = cnt1 + cnt2
  where
-- 基数2から1000までは直接調べる
    cnt1 = length [b | b <-[2..1000], isValid b n]
-- 6ビットパターンについて、b進法で解釈してn以上になる最大値を二分探索で探し、
-- それがドンピシャなら数える
    ub = succ n
    lb = 1000
    prop x b = readAs b x >= n
    cnt2 = length
      [ b
      | x <- [1..63]
      , prop x ub, not (prop x lb)
      , let (_,b) = binarySearch (prop x) lb ub
      , readAs b x == n
      ]
```
結果は [155ms, 5MBでAC](https://atcoder.jp/contests/abc293/submissions/39694987)

そもそも、ビットパターンを総当たりで生成する、というアプローチに現実味があるとは思いもよらなかったし、正しいbが密な区間と疎な区間でアプローチを切り替えるという発想も（つい最近[別件](https://project-euler-ja.gitbook.io/project-euler-ja/301-400/301-310/p303)でやったところなのに、というか内容は違うけど明らかに類題だこれ）気づかなかった。

# 感想

問題E,Fで、固定幅整数の端っこぎりぎりで溢れないように工夫するとか、あふれるけど計算量は制限できるから多倍長整数で片づけるとか、いつもとは違う角度での思考を要求された気がする。

あと、E,Fと2問も歯ごたえある別解があったので、そういう意味でもお腹いっぱいです。