ABC286 A～E+F をHaskellで

(1/22 13:00 Fが解けたので追記。）

# A - Range Swap

[問題 ABC286A](https://atcoder.jp/contests/abc286/tasks/abc286_a)

シグネチャを決める。手抜きする。

```haskell
abc286a :: [Int]  -- N,P,Q,R,S
        -> [Int]  -- Ai
        -> [Int]  -- 答え Bi
```

後ろから操作すると位置がずれない。

## 結果

```haskell
abc286a [n,p,q,r,s] as = a1 ++ a4 ++ a3 ++ a2 ++ a5
  where
    (a1234,a5) = splitAt s as
    (a123 ,a4) = splitAt (pred r) a1234
    (a12  ,a3) = splitAt q a123
    (a1   ,a2) = splitAt (pred p) a12
```

# B - Cat

[問題 ABC286B](https://atcoder.jp/contests/abc286/tasks/abc286_b)

「連続して」含まれる、という言い回しは微妙な気がする。

シグネチャを決める。

```haskell
abc286b :: Int     -- N
        -> String  -- S
        -> String  -- 答え
```

## 結果

```haskell
abc286b n = loop

loop ('n':'a':s) = 'n':'y':'a':loop s
loop (c:s) = c : loop s
loop "" = ""
```

# C - Rotate and Palindrome

[問題 ABC286C](https://atcoder.jp/contests/abc286/tasks/abc286_c)

シグネチャを決める。

```haskell
abc286c :: Int     -- N
        -> Int     -- A
        -> Int     -- B
        -> String  -- S
        -> Int     -- 答え
```

文字列を折りたたんで合わせてみて、異なる箇所の数 $\times B$ 円で回文にできる。
ローテートを $k$ 回してから折りたたむ場合、$kA$ 円余計にかかる。
$N \leq 5000$ なので総当たりでやる。

とはいえ、リストのままでするのは効率が悪そう、配列に置いてやるのでは命令型言語のコードと変わり映えしないので、`Data.Sequence` を使ってみよう。

## 結果

```haskell
import qualified Data.Sequence as Q
import Data.List

abc286c :: Int -> Int -> Int -> String -> Int
abc286c n a b s =
    minimum $                -- 5.最小値を選ぶ
    zipWith (+) [0, a ..] $  -- 4.回転のコストを加えて
    map ((b *) . cost) $     -- 3.合わせる文字数のコストを求めて
    take n $                 -- 2.元に戻るまで全ての場合で
    iterate rotate (q1, q2)  -- 1.ひたすら回転させ
  where
    (s1,s2) = splitAt (div (succ n) 2) s
    q1 = Q.fromList s1            -- 前半分
--  q2 = Q.fromList $ reverse s2  -- 後ろ半分の逆向き
    q2 = foldl' (flip (Q.:<|)) Q.Empty s2

-- q1の左端→q2の左端, q2の右端->q1の右端 で回転
rotate (a1 Q.:<| q1, q2 Q.:|> am) = (q1 Q.|> am, a1 Q.<| q2)

-- 二つの列で一致しない位置の個数を数える
cost (q1, q2) = loop q1 q2 0
  where
    loop (a Q.:<| q1) (b Q.:<| q2) c = loop q1 q2 $ if a == b then c else succ c
    loop _ _ c = c
-- cost = length . Q.findIndicesL id . uncurry (Q.zipWith (/=))
```

`Sequence`は効率がそれほど良くないため、`cost`関数の手作業での最適化は効果があった。

# D - Money in Hand

[問題 ABC286D](https://atcoder.jp/contests/abc286/tasks/abc286_d)

シグネチャを決める。

```haskell
abc286d :: Int          -- N
        -> Int          -- X
        -> [(Int,Int)]  -- Ai, Bi
        -> Bool         -- 答え
```

$\sum Bi$ 個の荷物を選んで、スコア $\sum Ai$ をちょうど $X$ にできるか、というナップザック問題。

`Data.IntSet` を信じて力任せにする…

```haskell
import qualified Data.IntSet as IS

abc286d :: Int -> Int -> [(Int,Int)] -> Bool
abc286d n x abs = IS.member x s
  where
    s = foldl step (IS.singleton 0) abs
    step s _ | IS.member x s = s
    step s (a, b) = IS.unions $ take (succ b) $ iterate (IS.map (a +)) s
```

とテストケース2つだけTLEした。
$X$ を超える値は作らないようにだけ工夫する。

## 結果

```haskell
import qualified Data.IntSet as IS

abc286d :: Int -> Int -> [(Int,Int)] -> Bool
abc286d n x abs = IS.member x s
  where
    s = foldl step (IS.singleton 0) abs
    step s _ | IS.member x s = s
    step s (a, b) = IS.unions
      [ IS.fromDistinctAscList $ take (succ b) $ takeWhile (x >=) [i, i+a ..]
      | i <- IS.elems s
      ]
```

# E - Souvenir

[問題 ABC286E](https://atcoder.jp/contests/abc286/tasks/abc286_e)

直行便のある都市 $S$ から都市 $T$ への移動を、重み $(1, -A_S)$ な辺として、重みが最小な経路を探す。$U$ から $V$ に重みの総和 $(K,A)$ で移動できるとき、直行便の本数は $K$、お土産の価値の総和は $A_V - A$ となる。

$N \leq 300$ なので、ワーシャルフロイド法を想定していると考えられる。

ワーシャルフロイド法でするなら、クエリの対応に入る前にほとんどの計算は終わっているが、クエリごとに計算を行うスタイルにしてみる。
という前提でシグネチャを決める。

```haskell
import Data.Array.IO
import Data.Array

type DA = IOArray (Int,Int) (Int,Int) -- 距離の表

-- 前処理
abc286ep :: Int       -- N
         -> [Int]     -- Ai
         -> [String]  -- Si
         -> IO DA     -- 距離の表

-- クエリ対応
abc286em :: DA            -- 距離の表
         -> Array Int Int -- Ai
         -> Int           -- Ui
         -> Int           -- Vi
         -> IO String     -- 答え
```

## 結果

```haskell
import Control.Monad

abc286ep n as ss = do
  arr <- newListArray ((1,1),(n,n)) $
    [ if sij == 'N' then (maxBound, 0) else (1, - ai)
    | (si,ai) <- zip ss as, sij <- si]
  forM_ [1..n] (\k ->
    forM_ [1..n] (\i -> do
      dik <- readArray arr (i,k)
      when (dik < (maxBound, 0)) (
        forM_ [1..n] (\j -> do
          dkj <- readArray arr (k,j)
          when (dkj < (maxBound, 0)) $ do
            let dikj = add dik dkj
            dij <- readArray arr (i,j)
            when (dij > dikj) $ writeArray arr (i,j) dikj
          )
        )
      )
    )
  return arr

add (a,b) (c,d) = (a+c,b+d)

abc286em arr aa i j = do
  (k, a) <- readArray arr (i,j)
  return $ if k == maxBound then "Impossible" else unwords [show k, show $ aa ! j - a]
```

クエリ対応の段階では距離の表は書き変えないため、前処理の配列に `Data.Array.ST` を用いて、`runSTArray` で immutable な配列を返すようにした版は[TLE した。](https://atcoder.jp/contests/abc286/submissions/38235250)

上のコードは、純粋配列への変換をあきらめて、`IOArray` で保持し続ける形に変更しただけなのだが、[これで普通に間に合う。](https://atcoder.jp/contests/abc286/submissions/38235338)

# F - Guess The Number 2

解けたので追記。壁に突き当たったのでアライさんのヒントを見た。

[問題 ABC286F](https://atcoder.jp/contests/abc286/tasks/abc286_f)

いつもだと、$A$ と大きな $N$ を与えられて、$B_i = f^N(i)$ を求めるのに、べき乗を二進数で高速化する方法をするような問題設定で、$A$ をこちらが与えて、相手の $N$ を当てろという、立場の逆転した話。

$f(i) = A_i$ は関数なので移動先は一つに決まり、有向グラフは、終点がないので必ずループになり、また合流がありうるが、分岐はない。
長さ $P$ のループがあるとき、ループの中の頂点から始めて $N$ ステップ移動したら、ループを $Q$ 周してさらに $R$ 進んだ位置で止まったとすると、$N = PQ + R$ である。ここで $P$ が操作可能、$R$ は観測可能、$Q$ は不明で $N$ が目的変数である。

$Q$ が不明なのが厳しく感じられるが、$M \leq 110$ の許す範囲で異なる長さのループを複数作ってそれぞれの余りを数えると、中国剰余定理で $N$ を特定できる。

この問題で中国剰余定理を使って $N$ を求めるには、互いに素な整数群で、和が $110$ 以下で積が $10^9$ 以上となるものが必要である。

```haskell
> :m + Data.Numbers.Primes
> :m + Data.Set

> step s k = union s $ fromList [(p0*k,s1,k:ps) | (p0,s0,ps) <- elems s, let s1 = s0 + k, s1 <= 110]
> s = Data.List.foldl' step (singleton (1,0,[])) $ takeWhile (110 >=) primes
> maximum s
(340510170,110,[29,23,17,13,11,7,5,3,2])
> compare 340510170 (10^9)
LT
```

あれ？足らない。

https://twitter.com/kyopro_friends/status/1616796401555628032

方向性はあってるけど、素数でない数も使って110以下に抑えるその数の組み合わせがある、っていうのはどこから出てくるの…

```haskell
> step s k = union s $ fromList [(l1,s1,k:ps) | (l0,s0,ps) <- elems s, let l1 = lcm l0 k, l1 /= l0, let s1 = s0 + k, s1 <= 110]
> s = Data.List.foldl' step (singleton (1,0,[])) [110,109..2]
> [e | e@(l,_,_) <- elems s, l >= 10^9]
[(1338557220,108,[4,5,7,9,11,13,17,19,23])]
```

ふわぁ。（なお `[2..110]` で探すと無限に時間がかかる）

## フェーズ1

上で見つけたループ長をなす $A_i$ を固定的に出力すればよい。

```haskell
import Data.List

theList = [4,5,7,9,11,13,17,19,23]
as = concat $ snd $ mapAccumL step 1 theList
  where
    step b l = (b+l, take (pred l) [succ b..] ++ [b])

phase1 = do
  print 108
  putStrLn $ unwords $ map show as
```

## フェーズ2

受け取った $B_i$ のうち、ループ先頭の位置の値（と元の値との差）だけが必要になる。

```haskell
phase2 :: [Int] -> Int
phase2 bs = ...
  where
    bs1 = map (bs !!) $ init $ scanl (+) 0 theList
    rs = zipWith (-) bs1 $ scanl (+) 1 theList
    ...
```

作り置きの中国剰余定理を計算する関数がこちら。

```haskell
import Control.Monad

-- @gotoki_no_joe
crt :: [(Int,Int)] -> Maybe (Int,Int)
crt = foldM step1 (0,1)
  where
    step1 (r0,m0) (r1,m1)
      | m0 < m1   = step2 (mod r1 m1) m1 r0 m0
      | otherwise = step2 r0 m0 (mod r1 m1) m1
    step2 r0 m0 r1 m1
      | mod m0 m1 == 0 = if mod r0 m1 == r1 then Just (r0, m0) else Nothing
      | r /= 0         = Nothing
      | otherwise      = Just (r0 + x * m0, m0 * u)
      where
        (g,im) = invGCD m0 m1
        (q, r) = divMod (r1 - r0) g
        u = div m1 g
        x = mod (mod q u * im) u

invGCD :: Int -> Int -> (Int, Int)
invGCD a b
  | a1 == 0 = (b, 0)
  | otherwise = loop b a1 0 1
  where
    a1 = mod a b
    loop s 0 m0 m1 = (s, if m0 < 0 then m0 + div b s else m0)
    loop s t m0 m1 = loop t (s - t * u) m1 (m0 - m1 * u)
      where
        u = div s t
```

答えはあるに決まっているので決め打ちする。

```haskell
phase2 :: [Int] -> Int
phase2 bs = ans
  where
    bs1 = ...
    rs = ...
    Just (ans,_) = crt $ zip rs theList
```

## 結果

[こちら。](https://atcoder.jp/contests/abc286/submissions/38240789)