ABC358をHaskellで

# A - Welcome to AtCoder Land

[問題 ABC358A](https://atcoder.jp/contests/abc358/tasks/abc358_a)

シグネチャを決める。SとTで分けるのも面倒なのでしない。

```haskell
abc358a :: String -- S,T
        -> String -- 答え
abc358a "AtCoder Land" = "Yes"
abc358a _              = "No"
```

# B - Ticket Counter

[問題 ABC358B](https://atcoder.jp/contests/abc358/tasks/abc358_b)

シグネチャを決める。

```haskell
abc358b :: Int   -- N
        -> Int   -- A
        -> [Int] -- Ti
        -> [Int] -- 答え
```

一人前の人がチケット購入し終えた時刻（つまり一人前の答え）$P$ を持ち回す。
それが $T_i$ より大きいとき、今回の人はその時刻まで待たされる。
そうでないとき、窓口は空いているので即座に手続きが進む。
つまり、$\max(P, T_i) + A$ が人 $i$ の完了時刻となる。

## 結果

```haskell
abc358b _n a ts = tail $ scanl step 0 ts
  where
    step p ti = a + max p ti
```

# C - Popcorn

[問題 ABC358C](https://atcoder.jp/contests/abc358/tasks/abc358_c)

シグネチャを決める。

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

$S_i$ の `x` を 1, `o` を 0 として2進数に直して考える。（微妙に普通と逆）この値を $X_i$ とする。
訪問する売り場の $X_i$ について、ビットごとのANDをとると、買える味のビットは0になり、買えない味のビットは1になる。

N箇所の売り場をそれぞれ使う、使わないの総当たり $2^N - 1$ とおりを試し、使う個数の最小値を探す。この段階でも2進数を使い、整数1 ～ $2^N - 1$ のビット i が1のとき、売り場 i を使うとする。

## 結果

```haskell
import Data.List
import Data.Bits

abc358c :: Int -> Int -> [String] -> Int
abc358c n _m ss = minimum
    [ popCount j
    | j <- [1 .. 2^n - 1]
    , 0 == foldl1 (.&.) [x | (i,x) <- zip [0..] xs, testBit j i]
    ]
  where
    xs = map s2x ss
    s2x cs = sum [b | ('x', b) <- zip cs $ iterate (2 *) 1] -- Xiを作る関数
```

# D - Souvenirs

[問題 ABC358D](https://atcoder.jp/contests/abc358/tasks/abc358_d)

シグネチャを決める。

```haskell
abc358d :: Int   -- N
        -> Int   -- M
        -> [Int] -- Ai
        -> [Int] -- Bi
        -> Int   -- 答え
```

[フレンズさんいわく](https://twitter.com/kyopro_friends/status/1801976383767535658)
> アライグマ「D問題は、「まだ買ってないお土産のうち、必要なサイズギリギリのものを買う」を繰り返せばいいのだ！

を実装するには、$A_i$ の内容を多重集合に入れておき、$B_j$ は任意なので入力のままの順序で、それ以上で最も小さいものを選択して取り除く、を繰り返した総和を求める、とすることができるが、多重集合が面倒くさい。

$A_i$ と $B_j$ の双方を昇順にソートしておき、前から順に比較して、小さい $A_i$ は捨て、使えるものが見つかったところでそれを購入する、を続けて、$B_j$ を無くすことができるかを調べるやり方なら、リストの再帰だけでできる。

## 結果

```haskell
import Data.List

abc358d :: Int -> Int -> [Int] -> [Int] -> Int
abc358d _n _m as bs = loop 0 (sort as) (sort bs)
  where
    loop acc (a:as) bbs@(b:bs)
      | a >= b    = loop (acc + a) as bs  -- BjにはAiをあてがう
      | otherwise = loop acc as bbs       -- Aiは使えないのでスルー
    loop acc _ [] = acc                   -- 全員分選べた
    loop _cc [] _ = -1                    -- 選びきれずに終わった
```

# E - Alphabet Tiles

[問題 ABC358E](https://atcoder.jp/contests/abc358/tasks/abc358_e)

シグネチャを決める。

```haskell
abc358e :: Int   -- K
        -> [Int] -- Ci
        -> Int   -- 答え
```

文字 $i$ 以降だけを使って、長さ $j$ の文字列を作る場合の数を $cnt[i,j]$ とする。
基底として $cnt[27,0] = 1, cnt[27, j > 0] = 0$ である。
再帰部として、文字 $i+1$ 以降はあるとして、文字 $i$ について考える。
長さ $j$ の文字列の枠から $b$ $(0 \leq b \leq \min(j,C_i))$ 個を選んで文字 $i$ を書き込み、残りの枠 $j - b$ 個に文字 $i+1$ 以降を順に当てはめる場合の数は ${}\_j C\_b \times cnt[i+1, j-b]$ である。$b$ に関して総和をとった結果が $cnt[i,j]$ になる。
最終的な答えは $\sum_{b=1}^K cnt[1,b]$ である。

## 結果

遅延配列による暗黙のDPで実装する。

```haskell
import Data.Array

abc358e :: Int -> [Int] -> Int
abc358e k cs = summ [cnt ! (1,b) | b <- [1 .. k]]
  where
  -- パスカルの三角形で nCr (n ≦ k) の表
    comb = listArray (0,k) [listArray (0, i) $ map (combF i) [0 .. i] | i <- [0 .. k]]
    combF n r
      | r == 0 || r == n = 1
      | otherwise = add (comb ! pred n ! pred r) (comb ! pred n ! r)
    cA = listArray (1,26) cs
    bnds = ((1,0),(27,k))
    cnt = listArray bnds $ map cntF $ range bnds
    cntF (27, 0) = 1
    cntF (27, _) = 0
    cntF (c, b) = summ [mul (cnt ! (succ c, b - i)) (comb ! b ! i) | i <- [0 .. min b $ cA ! c]]

modBase :: Int
modBase =  998244353

reg :: Int -> Int
reg x = mod x modBase
add, mul :: Int -> Int -> Int
add x y = reg $ x + y
mul x y = reg $ x * y

summ :: [Int] -> Int
summ = foldl' add 0
```

# F - Easiest Maze

[問題 ABC358F](https://atcoder.jp/contests/abc358/tasks/abc358_f)

シグネチャを決める。結果はそのまま `putStrLn` できる改行入り文字列にする。
この出力形式もややこしそうだ。

```haskell
abc358e :: Int   -- N
        -> Int   -- M
        -> Int   -- K
        -> String -- 答え
```

## 考える

出力形式がややこしいので、純粋に経路を構築するステップと、その経路を出力形式に合わせるステップとを別にする。前半は、位置(0,M) （(1,M)でなく）から開始し (N,M) に至る、`UDLR` の列 K 文字を返す。

何ともタイムリーなツイ

https://x.com/_shimada/status/1800473252504244445

の形式なら出力サイズが抑えられたのに。

### 経路の構築

最も短い経路は、SからGまでの一本道。これより小さいKは満たせない。

2行を越える一本道 DD を L{w}DR{w}D と寄り道することで、2w (w < M) だけ経路を延長できる。
Nが偶数のとき、これで全てのマスを埋めることができ、上限 NM までの任意の偶数の K を満たす経路が作れる。

Nが奇数のとき、うえのつづら折り方式では、使えない行が1行発生する。
$K \leq (N-1)M$ なら、最初の1行を無視して $N-1$ 行という偶数行についてつづら折りで済ませられる。

それでは無理なとき、最初の3行で LULD ... RR と今度は横方向に幅2のつづら折りをして、6マスずつ消費できる。
消費するべきマスの量 X に応じて、
- 6以上：LULD (X-6を消費する経路) RR
- 4： LLDRR
- 2： LDR
- 0： D

と再帰的に経路が構築できる。
この方法で、結局偶数個ずつマスが消費され、今度は、Mが偶数のとき、左上に1マスだけ、どうしても通過できないマスが発生する。つまり達成可能な上限はこの場合1少ない。

### 出力形式の構築

文字の配列に書き込んで作る。

- まず全体を `+` で塗りつぶし
- SとGを書き込み
- 全ての部屋に `o` を書く
- 縦の壁 `|` と横の壁 `-` を全て立てる
- 発見した経路を辿り、必要な壁を `.` で上書きして壊す

とした。

### 結果

コードは [提出](https://atcoder.jp/contests/abc358/submissions/54662401) を参照。

# G - AtCoder Tour

[問題 ABC358G](https://atcoder.jp/contests/abc358/tasks/abc358_g)

シグネチャを決める。引数が多いので横着する。

```haskell
abc358e :: [Int]   -- H,W,K
        -> [Int]   -- Si,Sj
        -> [[Int]] -- Aij
        -> Int     -- 答え
```

わからなくて解説を見た。以下、おおむね公式解説に沿った実装。

最適な戦略は、高得点な経路で目的位置まで移動し（最短とは限らない）、その後は移動せずにその位置のスコアをひたすら受け取る、という行動になる。
そのため、考慮するべき移動回数は $HW$ が上限で、$K$ まで考えなくてよい。

開始位置から移動してきて、時刻 $t$ に位置 $(i,j)$ に居るような場合のスコアの最大値を $sc[t,i,j]$ とする。
時刻 0 では開始位置にしか居るはずがないので $sc[0,S_i,S_j] = 0, sc[0,i \neq S_i,j \neq S_j] = -\infty$ である。
次の時刻では、前の時刻の上下左右から移動してきて、または移動せずにこのマスのスコアを獲得するので $sc[t+1,i,j] = A_{i,j} + \max(sc[t,i,j], sc[t,i-1,j], sc[t,i+1,j], sc[t,i,j-1], sc[t,i,j+1])$ となる。

追跡するべき移動回数を移動し終えた時刻 $T_1 = \min(K, HW)$ について $sc[T_1,i,j]$ を得たら、残りの時間でのスコアを加えた $\max \left \\{ A_{i,j} \cdot (K - T_1) + sc[T_1,i,j] \right \\}$ が答え。

（解説だと、各時刻について、その後移動しないとした場合の最終スコアを調べているが、移動しないという選択肢もDPで調べることで、時刻 $T_1$ の状況だけから計算できる。）

## 結果

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

abc358g :: [Int] -> [Int] -> [[Int]] -> Int
abc358g [h,w,k] [si,sj] ass = maximum [scZ ! ij + (k - t1) * aij | (ij, aij) <- assocs a]
  where
    a = listArray ((1,1),(h,w)) $ concat ass :: UArray (Int,Int) Int
    bnds = ((0,0),(succ h, succ w))
    sc0 = accumArray (flip const) minBound bnds [((si,sj), 0)] :: UArray (Int,Int) Int
    t1 = min k $ h * w
    scZ = foldl' step sc0 [1 .. t1]
    step sc t = sc0 //
      [  (ij, aij + maximum [sc ! ij1 | ij1 <- [ij, (succ i,j), (pred i,j), (i, succ j), (i, pred j)]])
      | (ij@(i,j), aij) <- assocs a
      ]
```
(24-6-19追記：`step`で新規に配列を作る代わりに、実質全面を `(//)` で書き換える形に変更しました。）