ABC271 A～E+F をHaskellで

# A - 484558

[問題 ABC271A](https://atcoder.jp/contests/abc271/tasks/abc271_a)

タイトルは、2桁ずつ16進数として読んでASCIIコードで文字にすると

```haskell
> map (Data.Char.chr . fst . head . Numeric.readHex) ["48","45","58"]
"HEX"
```

シグネチャを決める。

```haskell
abc271a :: Int     -- N
        -> String  -- 答え2文字
```

`Numeric`モジュールで、10進表記でない基数での読み書き関数が提供されている。
leading zeroを付け加えるズボラな方法は、より上位の桁に数字が現れるように大きな数を足してから文字列化して、その追加の桁を取り去ることでできる。

## 結果

```haskell
import Data.Char
import Numeric

abc271a :: Int -> String
abc271a n = map toUpper $ tail $ showHex (n + 256) ""
```

$256_{(10)} = 100_{(16)}$ なので必ず3桁になり、先頭の `1` を除くと2桁になる。

## 自分でやる

基数変換を自前でやれ、という出題の意図を感じるならばそうしよう。

```haskell
abc271a n = map (ds !!) [q, r]
  where
    (q,r) = divMod n 16
    ds = "0123456789ABCDEF"
```

# B - Maintain Multiple Sequences

[問題 ABC271B](https://atcoder.jp/contests/abc271/tasks/abc271_b)

命令型言語なら特に面倒はない内容なのだが…

ファイル入出力の問題で、主体は計算ではないのでシグネチャは書かない。`main`に全て納める。

ランダムアクセスを $Q \leq 10^5$ 回行うので、高速な配列に格納しておきたい。
ByteStringも行単位の処理が基本なのに合わせて、行ごとに `Data.Array.listArray` や `Data.Vector.fromList` でちまちま配列に直しているとTLEしてしまう。
データの行数は $N \leq 2 \times 10^5$　であるが、全ての行に渡ってのデータの総数も $\sum L_i \leq 2 \times 10^5$ で制限されているので、これだけの要素を持つ単一のベクタに全てのデータを入れてしまう。（データ数ぴったりの配列をあきらめる。）
行ごとに読み込む際に、先頭要素 $L_i$ の位置を開始位置配列に記録しておくことで、クエリの $t_j$ をどこから数えたらよいかわかるようにする。

## 結果

$L_i$を記録しないように除外できれば `v` のサイズは半分で済むが、それも面倒なので妥協した。

```haskell
import Control.Monad
import qualified Data.ByteString.Char8 as BS
import Data.Char
import Data.List

import qualified Data.Vector.Unboxed.Mutable as MUV

main = do
  [n,q] <- bsGetLnInts
  v <- MUV.new (400001)  -- Liとaij全てを並べて入れる
  lv <- MUV.new (succ n) -- 各iに対してLiの入ったvの添え字
  foldM (\p i -> do      -- 行iの内容をpからの位置に格納
    MUV.write lv i p     --   行iの内容は位置pから始まっている
    bs <- BS.getLine
    loop v bs p          --   行iの内容を続けて書き込む
    ) 0 [1..n]
  replicateM_ q $ do     -- クエリに対応
    [s,t] <- bsGetLnInts
    l <- MUV.read lv s
    a <- MUV.read v (l + t)
    print a

loop v bs i =
  case BS.readInt (BS.dropWhile isSpace bs) of
    Just (x, bs1) -> do { MUV.write v i x; loop v bs1 (succ i) }
    Nothing -> return i

bsGetLnInts :: IO [Int]
bsGetLnInts = BS.getLine >>= return . unfoldr (BS.readInt . BS.dropWhile isSpace)
```

# C - Manga

[問題 ABC271C](https://atcoder.jp/contests/abc271/tasks/abc271_c)

シグネチャを決める。

```haskell
abc271c :: Int    -- N
        -> [Int]  -- ai
        -> Int    -- 答え
```

[mex(minimum exluded)](https://en.wikipedia.org/wiki/Mex_(mathematics))の話かと身構えた。
$a_i$ を前から調べていき、初出ならmexに加え、さもなくば売れる本の冊数に加えていく。
終わったら、1からmexを調べるが、売れる本が2冊あるごとに、その巻はあるものとして追加してmexを調べなおす。

しかし、例1にある271巻のように、1冊目だけれど使わないものを回収するとなると、mexの実装ではやることがちまちましすぎて相性がよくない。いっそ `IntSet` の最大最小周りの関数を使ってやってしまえばよさそう。

## 結果

```haskell
import qualified Data.IntSet as IS

abc271c :: Int -> [Int] -> int
abc271c n as = loop is cnt 1
  where
    (is, cnt) = foldl step (IS.empty, 0) as
    step (is, cnt) a
      | IS.member a is = (is, succ cnt)         -- ダブりは売却
      | otherwise      = (IS.insert a is, cnt)  -- 新規は登録

loop :: IS.IntSet  -- 持っていてまだ読んでいない巻の集合
     -> Int        -- 売却できる冊数
     -> Int        -- 今から読みたい巻
     -> Int        -- 答え、読めた最終巻
loop is cnt i
  | IS.null is     = pred i + div cnt 2
  | IS.member i is = loop (IS.delete i is) cnt (succ i)  -- 正常系
  | cnt >= 2       = loop is (cnt - 2) (succ i)
  | otherwise      = loop (IS.deleteMax is) (succ cnt) i
```

手持ちが足らなくなったときに、届かないであろう最終巻から売り飛ばす。(場合4)
このとき、読み終わった古い巻を売ってしまうことがないように、読み終わった巻は取り除いておく必要がある。(場合2の`deleteMin`)
手持ちの巻を売るより先に、重複の巻を売る。(場合3)
手持ちが全くないなら、買えるだけ続きを買って終わる。(場合1)

場合1で先に空集合判定をしているので、場合4で「まだ売る巻がある」ことを判定しなおす必要がない。

# D - Flip and Adjust

[問題 ABC271D](https://atcoder.jp/contests/abc271/tasks/abc271_d)

シグネチャを決める。
結果が `Yes` なら2行めに出力するべき文字列を、`No` なら空文字列を返す。
（$1 \leq N$なので、`Yes`であって空文字列を返すべき場合はない。）

```haskell
abc271d :: Int          -- N
        -> Int          -- S
        -> [(Int,Int)]  -- ai,bi
        -> String       -- 答え
```

$N \leq 100$ 枚のカードを、表のままにする(hold)か裏にする(turn)かの場合は $2^{100}$ 通りになり、それらの可能性全てを管理すると大変なことになりそうだが、$a_i, b_i \leq 100$ なので最大の場合でも総和は $100 \times 100$ 以下、そして目標値も $S \leq 10000$ なので、全ての場合を考えても計算機からあふれ出すことはない。

原理主義的には `Data.IntMap` で、和をキー、値を `HT*` として作り、キーに $a_i$ 値に `H` を加えたものと、キーに $b_i$ 値に `T` を加えたものを `union` する、という感じにしたい。

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

abc271d :: Int -> Int -> [(Int,Int)] -> String
abc271d n s abs = maybe "" reverse $ IM.lookup s m
  where
    m = foldl step (IM.singleton 0 "") abs
    step m (a,b) = IM.union m1 m2
      where
        m1 = IM.map ('H' :) $ IM.mapKeysMonotonic (a +) m
        m2 = IM.map ('T' :) $ IM.mapKeysMonotonic (b +) m
```

しかしむしろ、キーが昇順に、かつ $S$ 以下になるように注意しながら対応付けリストでやってしまった方がシンプルな気がする。

## 結果

```haskell
abc271d n s abs
  | null cds  = ""         -- 全て S を超えた場合
  | c /= s    = ""         -- Sがない場合
  | otherwise = reverse d  -- 答えがあった場合
  where
    cds = foldl step [(0,"")] abs
    step cds (a,b) = merge (add cds a 'H') (add cds b 'T')
    add cds x ht = [(c + x, ht:d) | (c,d) <- takeWhile ((s - x >=) . fst) cds]
    (c,d) = last cds

merge xxs@(x:xs) yys@(y:ys) =
  case compare (fst x) (fst y) of
    EQ -> x : merge xs  ys
    LT -> x : merge xs yys
    GT -> y : merge xxs ys
merge [] ys = ys
merge xs [] = xs
```

# E - Subsequence Path

[問題 ABC271E](https://atcoder.jp/contests/abc271/tasks/abc271_e)

シグネチャを決める。

```haskell
abc271e :: Int              -- N
        -> Int              -- M
        -> Int              -- K
        -> [(Int,Int,Int)]  -- Ai,Bi,Ci
        -> [Int]            -- Ei
        -> Int              -- 答え
```

$E_1$は、$A_{E_1} = 1$ ならば出発できるが、そうでなければ「$1$から$N$に至る良い経路」に使われることはない。
というように、$E_i$ を前から順に調べ、$A_{E_i}$ がその手前までで到達できる都市であるなら、$B_{E_i}$ へも到達できる、とわかる。ただし、都市 $B_{E_i}$ がもっと早く到達できるならその経路は無視してよいので、それぞれの都市について、今までの良い経路での最短距離を記録していく。
$E_K$ まで調べ終わったら、都市 $N$ までの良い経路での最短距離も得られている。

## 結果

ちまちまと表を更新する必要があるのでmutable vectorで実現する。
未到達は `Maybe` を使うと面倒なので巨大な値で表す。

```haskell
import qualified Data.Vector as V
import qualified Data.Vector.Unboxed.Mutable as MUV
import Control.Monad.ST

tooBig :: Int
tooBig = div maxBound 2

abc271e :: Int -> Int -> Int -> [(Int,Int,Int)] -> [Int] -> Int
abc271e n m k abcs es = runST action
  where
    abcV = V.fromList $ (0,0,0) : abcs
    action :: ST s Int
    action = do
      dist <- MUV.replicate (succ n) tooBig      -- 都市2～Nは距離∞
      MUV.write dist 1 0                         -- 都市1は距離0
      forM_ es (\e -> do
        let (a,b,c) = abcV V.! e
        dista <- MUV.read dist a
        MUV.modify dist (min (dista + c)) b      -- Eiを使うと近いなら更新
        )
      distn <- MUV.read dist n
      return $ if distn < tooBig then distn else -1
```

# 感想

手続き的な計算が多めだった…

# F - XOR on Grid Path

2022-10-02 ACできたので追記。

シグネチャを決める。

```haskell
abc271f :: Int       -- N
        -> [[Int]]   -- aij
        -> Int       -- 答え
abc271f n ass = ...
```

碁盤の目状の道路を通る方法、のバリエーション。
それぞれの位置に到達する経路全体で、xorの値ごとの場合の数を数え上げていく。
しかしこのままやると、探索の深さが $2N$ なので最悪で $2^{2N}$ 種類の値が起きうる。（実際には $a_{ij} < 2^{30}$ の方が小さいのでそこまでだが、どちらにしろ多すぎる。）

xorは、計算の順序を変えても大丈夫だし、もう一度同じ値を作用させると元に戻るという扱いやすい性質を持っている。
そこで、出発地点 $(1,1)$ から何らかの中間地点 $P(X,Y)$ までの経路における場合の数を調べ、同様にゴール $(N,N)$ から $P(X,Y)$ までの経路についても調べ、両者を突き合わせることで、組み合わせ爆発の指数を半分に抑える「半分全列挙」というテクニックを使う。

ということで、碁盤の目を上半分と下半分に分けてやってみる。「日」の字のように。
境界を挟む $(X,Y)$ と $(X,Y+1)$ の間には1本しか経路はないので、前者と後者で同じ値になる場合の数の積和を、$1 \leq X \leq N$ について足し合わせれば答えになる、というアプローチで実装したが、[TLEのままだった。](https://atcoder.jp/contests/abc271/submissions/35330756)
考えてみると、この分割のやり方だと、探索の深さは $N + N/2$ で、あまり浅くなっていない。

解説にもあるように、「〼」の字のように左上と右下で二等分すると、探索の深さは $N$ になるので、実際「日」よりもずっと軽くなる。
リスト処理でつるりと実装することをあきらめて、集めるDP配列を使う方針に切り替える。

## 解く

DPにより、全てのマス $(i,j)$ に対して、

- 「$(1,1)$ からそのマスまでの全経路で作られるxorの値についてその場合の数」という `IntMap` と、
- 「$(N,N)$ から（以下略）」という `IntMap`

の両方をペアで持つ二次元配列を作る。
ただし実際には、前者は左上のマスについてのみ、後者は右下のマスについてのみ使うので、参照されない要素は遅延評価により計算されずに放置される。（ズルイ！）
対角線上のマスだけは両方とも用いて、最終結果を取り出す。

まず $a_{ij}$ を配列に入れよう。
（`Array` の添え字を `(Int,Int)` にするとかなり遅い気がするので、入れ子の `Array Int` で作る）
(2022-10-4 追記：実際は、メモリ効率は悪化するが、時間効率はほぼ変化なし、でした。）

```haskell
aaa = listArray (1,n) $ map (listArray (1,n)) ass
```

DPをする配列の要素は、座標を引数として関数 `maf` で作る。

```haskell
maa = listArray (1,n) [listArray (1,n) $ map (maf i) [1..n] | i <- [1..n]]
```

$(1,1)$ と $(N,N)$ はその場の値ひととおり、になる。使わない側は未定義にしておく。

```haskell
maf i j
  | i == 1, j == 1 = (IM.singleton aij 1, undefined)
  | i == n, j == n = (undefined, IM.singleton aij 1)
  | ...
  where
    aij = aaa ! i ! j
```

その他の位置については、上隣と左隣からfstが、下隣と右隣からsndが作れる。

```haskell
maf i j
  | ...
  | otherwise = (ul, dr)
  where
    ul = {- 上隣 maa ! pred i ! j と左隣 maa ! i $ pred j を統合し、xor aij したIntmap -}
    dr = {- 下隣 maa ! succ i ! j と右隣 maa ! i $ succ j を統合し、xor aij したIntmap -}
```

隣がない隅については、場合の数は全て0、空だと見なす必要がある。そのままの添え字で配列をアクセスするとエラーになってしまうので、そのあたりの面倒を見るラッパー関数 `mar` を立てる。

```haskell
    ul = fun fst pred
    dr = fun snd succ
-- fs : fst/snd, ps : pred/succ
    fun fs ps = IM.mapKeys (xor aij) $
                IM.unionWith (+) (fs $ mar (ps i) j) (fs $ mar i (ps j))
mar i j
  | i < 1 || n < i || j < 1 || n < j = (IM.empty, IM.empty)
  | otherwise = maa ! i ! j
```

最終結果は、対角要素についてペアの両方の `IntMap` を取り出して突き合わせる。このままだと $a_{ij}$ が1回余計にかかっているので、もう一度かけることでキャンセルして、同じ値になる場合の数を積和する。

```haskell
abc271f n ass = sum                 -- 6. 総和をとる
  [ v * IM.findWithDefault 0 x1 m2  -- 5. m2の場合の数と積をとり
  | i <- [1..n], let j = succ n - i -- 1. 対角要素の座標を列挙して
  , let (m1, m2) = maa ! i ! j      -- 2. 二つのマップを取り出し
  , (x,v) <- IM.assocs m1           -- 3. m1の要素全てについて
  , let x1 = xor x (ass ! i ! j)    -- 4. aijをキャンセルして
  ]
```

## 結果

[提出したもので見てください。](https://atcoder.jp/contests/abc271/submissions/35334921)