ABC265 A～E をHaskellで

# A - Apple

[問題 ABC265A](https://atcoder.jp/contests/abc265/tasks/abc265_a)

シグネチャを決める。

```haskell
abc265a :: Int  -- X
        -> Int  -- Y
        -> Int  -- N
        -> Int  -- 答え
```

3個まとめ買いY円の方がお得なら、可能な限りそっちを使う。

## 結果

```haskell
abc265a x y n
  | 3 * x > y = y * q + x * r
  | otherwise = x * n
  where
    (q, r) = divMod n 3
```

# B - Explore

[問題 ABC265B](https://atcoder.jp/contests/abc265/tasks/abc265_b)

シグネチャを決める。

```haskell
abc265b :: Int -> Int -> Int   -- N,M,T
        -> [Int]               -- Ai
        -> [(Int,Int)]         -- (Xi,Yi)
        -> Bool                -- 答え
```

『持ち時間が 0 **以下**になるような移動は行うことができません。』ということで、ちょうど持ち時間が0になる場合もゲームオーバーになるという判定基準に注意する。

持ち時間ボーナスを $A_i$ のリストと同じ形に変換できればあとは前から数えるだけ。

## 結果

```haskell
abc265b n m t as xys = loop t as bs
  where
    bs = concat (zipWith diff xys ((0,0):xys)) ++ repeat 0
    diff (x1,y1) (x0,_) = replicate (x1 - x0 - 1) 0 ++ [y1]
    loop t _ _ | t <= 0 = False
    loop t (a:as) (b:bs) = loop (t + b - a) as bs
    loop _ [] _ = True
```

一部屋ずつ再帰で進むのが面倒になったら

```haskell
abc265b n m t as xys = all (0 <) $ scanl (+) t $ zipWith (-) bs as
  where
    bs = concat (zipWith diff xys ((0,0):xys)) ++ repeat 0
    diff (x1,y1) (x0,_) = replicate (x1 - x0 - 1) 0 ++ [y1]
```

# C - Belt Conveyor

[問題 ABC265C](https://atcoder.jp/contests/abc265/tasks/abc265_c)

シグネチャを決める。
出力形式は、Haskell原理主義者なら `Maybe (Int,Int)` とするべきだが日寄る。

```haskell
abc265c :: Int -> Int  -- H,W
        -> [String]    -- Gij gss
        -> [Int]       -- 答え [i,j] または [-1]
```

移動しようとして、外に落ちるならそこが終点。
マスの数 $H \times W$ だけ移動しても終わらないなら、どこかでループしている。
移動可能な残り回数と現在位置を変数として、再帰関数で書けそう。

```haskell
loop 0 _ _ = [-1]
loop cnt i j =
  case gss !! i !! j of
    'U' -> if i == 1 then [i,j] else loop (pred cnt) (pred i) j
    'D' -> if i == h then [i,j] else loop ...
```

4つの場合分けで、同じようなコードが4つ並ぶのを頑張って書く代わりに、書かないで済ますように頑張りたい。

## 結果

```haskell
abc265c h w gss = loop (h * w) 1 1
  where
    loop 0 _ _ = [-1]
    loop cnt i j =
      case gss !! i !! j of
        'U' -> sub (i == 1) (pred i) j
        'D' -> sub (i == h) (succ i) j
        'L' -> sub (j == 1) i (pred j)
        'R' -> sub (j == w) i (succ j)
      where
        sub cond i1 j1 = if cond then [i,j] else loop (pred cnt) i1 j1
```
<!--
これは美しくない。ボツ。
## 続き

とにかく素の再帰関数を残したくない。
ひたすら進む `step` 関数と、期限内に完了したか判定する部分を分ける。

```haskell
abc265c h w gss =
  case ea of
    Left (i,j) -> [i, j]
    _          -> [-1]
  where
    ea = last $ take (1 + h * w) $ unfoldr step (Right (1,1))
    step (Left _) = Nothing
    step (Right (i,j)) =
      case gss !! i !! j of
        'U' -> sub (i == 1) (pred i) j
        'D' -> sub (i == h) (succ i) j
        'L' -> sub (j == 1) i (pred j)
        'R' -> sub (j == w) i (succ j)
      where
        sub cond i1 j1 = if cond then Left (i, j) else Right (i1, j1)
```
-->

# D - Iroha and Haiku (New ABC Edition)

[問題 ABC265D](https://atcoder.jp/contests/abc265/tasks/abc265_d)

シグネチャを決める。

```haskell
abc265d :: Int -> Int  -- N,P
        -> Int -> Int  -- Q,R
        -> [Int]       -- Ai
        -> Bool        -- 答え
```

何度も $[Ai]$ の連続部分列の和を使う感じの問題なので、累積和か尺取り法か。

累積和の集合 $S$ を考えて、その中の要素 $x$ で、$x + P$, $x + P + Q$, $x + P + Q + R$の全てがやはり $S$ に含まれるようなものがあれば、そこが求めていた区間。

![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/196351/bccf0368-c8ea-3436-5d2c-94534b5a8b5e.png)

## 結果

```haskell
import qualified Data.IntSet as IS

abc265d :: Int -> Int -> Int -> Int -> [Int] -> Bool
abc265d n p q r as = not $ null
    [() | x <- aas, all (flip IS.member aSet) [x + p, x + pq, x + pqr]]
  where
    aas = scanl (+) 0 as
    aSet = IS.fromAscList aas
    pq = p + q
    pqr = pq + r
```

## 続き

尺取り法をナイーブに実装すると、$P$ の探索は普通に作れても、$Q$, $R$ の探索はゼロリセットされるためにTLEした。
[Tomii9273氏によるユーザ解説](https://atcoder.jp/contests/abc265/editorial/4688)によると、後ろの虫が右に伸びるとき、前の虫の左が縮むように丁寧に実装すれば尺取り法で解けるらしい。

## 結果

```haskell
abc265d n p q r as = loop as 0 as 0 as 0 as
  where
    loop as1 s0 as2 s1 as3 s2 as4
      | s0 == p, s1 == q, s2 == r         =  True
      | s0 >= p, s1 >= q, s2 <  r, nn as4 =  loop as1  s0       as2  s1       as3 (s2 + a4) at4
      | s0 >= p, s1 <  q         , nn as3 =  loop as1  s0       as2 (s1 + a3) at3 (s2 - a3) as4
      | s0 <  p                  , nn as2 =  loop as1 (s0 + a2) at2 (s1 - a2) as3  s2       as4
      | otherwise                = nn as1 && loop at1 (s0 - a1) as2  s1       as3  s2       as4
      where
        (a1:at1) = as1
        (a2:at2) = as2
        (a3:at3) = as3
        (a4:at4) = as4

nn = not . null
```

後ろの虫が前の虫にめり込んで、合計が負になっている状態を許容することで、コードが見通しよく書ける。とはいえオリジナルの手続き型コードの方が普通で、これは無理矢理書いた感が強い。

## 余談

最初、単純な尺取り虫を繋ぎ合わせて、$P$ が見つかったらその直後から $Q$ を探す虫を発進させる、つまり、$P$ と $Q$ が離れた場所にあってもヨシとしてしまう誤った版が[ACしてしまっていた](https://atcoder.jp/contests/abc265/submissions/34256007)。
翌日これを書いているうちにそのことに気づいたが、報告する前に[after_contest01が追加されていた](https://atcoder.jp/contests/abc265/submissions/34263468)。

# E - Warp

[問題 ABC265E](https://atcoder.jp/contests/abc265/tasks/abc265_e)

シグネチャを決める。$A \sim F$ は多いので妥協した。

```haskell
abc265e :: Int -> Int    -- N,M
        -> [Int]         -- [A,B,C,D,E,F]
        -> [(Int,Int)]   -- (Xi,Yi)
        -> Int           -- 答え
```

モジュロな足し算と正規化をとりあえず書いておく。

```haskell
modBase = 998244353
r x = mod x modBase
add x y = r (x + y)
```

よくある、碁盤の目の道路網を通り抜ける方法の場合の数をDPで数える問題の、分岐を3にした上で、ところどころが障害物で通れなくなっているアレンジ。同様にして数え上げたら何とかなるだろうか。

空間の広さに対して到達できる点の個数は少ないので、場合の数は配列で持つ代わりに座標からの写像で持つことにする。

```haskell
import qualified Data.Map as M
```

`Data.Map`の持つ演算を活用して書くとこんな感じになる。

```haskell
abc265e :: Int -> Int -> [Int] -> [(Int,Int)] -> Int
abc265e n m [a,b,c,d,e,f] xys = r $ sum $ M.elems countsN
  where
    countsN = (iterate step (M.singleton (0,0) 1)) !! n
    obsts = M.fromList [(xy, ()) | xy <- xys]
    step counts = M.difference counts1 obsts
      where
        counts1 = M.unionsWith add $ map f [(a,b),(c,d),(e,f)]
        f (dx,dy) = M.mapKeysMonotonic (\(x,y) -> (x+dx, y+dy)) counts
```

[公式解説](https://atcoder.jp/contests/abc265/editorial/4587)によると、『高速な言語であればこの解法でACを得ることができます』ということだが、このコードはsample3であえなくTLEする。

上の「X座標とY座標の対」から「カウント」への `Map` を、「X座標」から「「Y座標」から「カウント」への `IntMap`」への `IntMap`」に置き換えると、sample3を3294 msで算出できるようになったが、実際のテストケースと時間制限の下での結果に変化はなかった。

ここで公式解説を頼った。3種類のワープにそれぞれ $P,Q,R$ と名前をつけておく。

- 座標で考える代わりに、$P,Q,R$ のそれぞれの回数で考えてよい。
（⇒ 他のワープ方法と座標点が偶然合流しても配慮の必要はない）
（⇒ 座標のときカウント空間は疎になるが、回数だと密になり配列が使える）
- 現在のワープの総回数 $K$ は反復回数として持っているので、カウントの配列は $P$ の回数、$Q$ の回数、$R$ の回数の3次元ではなく2次元で済む（$R$ の回数は $K - P - Q$ である）
- 障害物の位置は集合で管理して $O(\log M)$ で判定できれば間に合う

$K$ 回ワープした時点での経路の個数を数えるカウント配列 $c_K[0 \leq P \leq K][0 \leq Q \leq K]\color{gray}{[R]}$ （Rの回数は $K-P-Q$ で暗黙に保持）から、$K+1$回ワープのカウント数 $c_{K+1}$ を $[P+1][Q]\color{gray}{[R]}$, $[P][Q+1]\color{gray}{[R]}$, $[P][Q]\color{gray}{[R+1]}$ に配るDPで計算する。

## 結果

```haskell
import qualified Data.Set as S
import Data.Array.Unboxed

abc265e n m [a,b,c,d,e,f] xys = r $ sum $ elems countsN
  where
    obsts = S.fromList xys
    counts0, countsN :: UArray (Int,Int) Int
    counts0 = accumArray (+) 0 ((0,0),(0,0)) [((0,0),1)]
    countsN = foldl' step counts0 [1..n]
    step counts k = a1 // ob
      where
        a1 = accumArray add 0 ((0,0),(k,k))
             [ (idx, c)
             | p <- [0..pred k], q <- [0..pred k - p]
             , let c = counts ! (p, q)
             , idx <- [(succ p, q), (p, succ q), (p, q)] ]
        ob = [ ((p,q), 0)
             | p <- [0..k], q <- [0..k - p], let r = k - p - q
             , let x = a * p + c * q + e * r
             , let y = b * p + d * q + f * r
             , S.member (x,y) obsts ]
```

`a1`を作る内包表記の中で毎回 `idx` が障害物に突入していないか確認する代わりに、障害物に一致する添え字を `ob` に作成し、その位置のカウントを0に戻している。
`k`が変わると`r`の意味が変わるため、`ob`は毎回作成しなければならない。