# ABC342 振り返り
- [HUAWEI Programming Contest 2024（AtCoder Beginner Contest 342） - AtCoder](https://atcoder.jp/contests/abc342)
- ABCD 4完 (1111) ··· [コンテスト成績証 - AtCoder](https://atcoder.jp/users/oceajigger/history/share/abc342)
![[スクリーンショット 2024-02-25 16.21.13.png]]
![[スクリーンショット 2024-02-25 16.22.05.png]]
ABC342 でした。
- A (灰) ··· 1度しか登場しない文字をバケットから見つけてその位置を前から探す
- B (灰) ··· 整数の登場位置をみつける逆の索引を作っておく
- C (茶) ··· 英小文字 26 文字からなる、変換規則の配列を作っておき、クエリに合わせて更新する。最後にその表を元に置換
- D (緑) ··· 高速素因数分解で全ての $A_i$ を分解し、平方数を構成するのに必要な素数が同じもの同士でバケットを作り $_nC_2$ を取る
- E (水, upsolve) ··· max ヒープのダイクストラ法。遷移にかかるコストを、現在の頂点地のコストを元に二分探索で動的に計算
という問題セットでした。
結果は 4完のパフォーマンス 1111。前回も 1111 のゾロ目で、今回も同じ数字になりました。珍しいこともあるものです。
D 問題では $0$ も平方数とみなすわけですがそれを特別扱いする必要があります。
その $0$ の答えに対する寄与数の数え上げ方を間違っていて 2 ペナ貰ってしまいました。少しもったいなかったです。
E に着手したところで残り30分ちょっとでしたが、upsolve でも実装に1時間程度かかりました。仮に時間があっても本番中に通すのは無理だったかも。ダイクストラ法の盆栽をもう少し磨く必要があると感じました。
----
## [A - Yay!](https://atcoder.jp/contests/abc342/tasks/abc342_a)
A 問題にしてはいつもより少し手間がかかる問題ですね。
バケットを作って、1文字だけの文字が何かを探して `findIndex` しました。
なお今回のように配列を対象に値から索引を探したいこともよくあるので `findArrayIndex` 関数を自作してあります。
役に立ちました。(といいつつ本番では盆栽の存在を忘れてました...)
```haskell
main :: IO ()
main = do
s <- getLine
let xs = toBucket ('a', 'z') s
x = fromJust $ findArrayIndex (== 1) xs
i = fromJust $ findIndex (== x) s
print $ i + 1
```
## [B - Which is ahead?](https://atcoder.jp/contests/abc342/tasks/abc342_b)
こういう、値からその値の出現位置を逆引きするという問題は B 問題あたりで頻出です。
逆引きインデックスを先に構築して、対応します。
```haskell
main :: IO ()
main = do
n <- getInt
ps <- getInts
q <- getInt
qs <- replicateM q getTuple
let ix = array @UArray (1, n) $ zip ps [1 :: Int ..]
for_ qs $ \(a, b) -> do
print $ if ix ! a < ix ! b then a else b
```
## [C - Many Replacement](https://atcoder.jp/contests/abc342/tasks/abc342_c)
やや沼った問題。一つ目の山場。
たとえば入力例 $1$ だと
```
7
atcoder
4
r a
t e
d v
a r
```
となっていて序盤に `r -> a` に写像されますが、終盤で `a -> r` に写像されるので結果的に `r` は `r -> a -> r` で `r` に戻ります。
これを文字列 $S$ に対してナイーブにやると計算量的は $O(NQ)$ で間に合わないので、工夫が必要です。
こういう、何かと何かをくっつけて同一視する。それがどんどん大きくなっていくものには Union-Find を思い浮かべます。
しかしこの問題は、文字の交換ではなくて一方通行の写像です。グラフで表現すると有向グラフになるので Union-Find だとうまくいかないはず。
自分も最初 Union-Find で考えていましたが、途中で反例に気づいて仕切り直し。
文字種は 26文字しかないので、各文字がどの文字に変換されるかのマップを配列でもって、都度その配列の値全体を更新する方法で計算量的に間に合います。割と力業です。
焦って実装したので Haskell らしからぬ、MArray による THE 手続きプログラミングになりました。
```haskell
update index c d = do
xs <- getAssocs index
let vs = map fst $ filterOnSnd (== c) xs
for_ vs $ \v ->
writeArray index v d
main :: IO ()
main = do
n <- getInt
s <- getLine
q <- getInt
qs <- replicateM q $ auto @(Char, Char)
ix <- newListArray @IOUArray ('a', 'z') ['a' .. 'z']
for_ qs $ \(c, d) -> do
update ix c d
ix' <- freeze ix :: IO (UArray Char Char)
putStrLn $ map (ix' !) s
```
しかし冷静に考えると、クエリ一回あたり配列全体の走査が走る、つまり配列自体が状態遷移すると考えられるのでミュータブルに以下のように記述しても計算量は同じです。そして定数倍はこっちの方が速かったです。
```haskell
main :: IO ()
main = do
_ <- getInt
s <- getLine
q <- getInt
qs <- replicateM q $ auto @(Char, Char)
let ix' = foldl' f (listArray @UArray ('a', 'z') ['a' .. 'z']) qs
where
f ix (ci, di) = do
ix // [(i, di) | (i, d) <- assocs ix, d == ci]
putStrLn $ map (ix' !) s
```
一つの入力に対して状態空間全体がその都度遷移するというモデルなので、そういえばいつもやってる DP で解けるなと思ってやったのがこちら。状態遷移厨としては、こういうコードでシュッと通してやりたかったです。Haskeller の矜持が問われます。
```haskell
main :: IO ()
main = do
n <- getInt
s <- getLine
q <- getInt
xs <- replicateM q $ auto @(Char, Char)
let dp = accumDP @UArray f (flip const) '*' ('a', 'z') [(c, c) | c <- ['a' .. 'z']] xs
where
f (c, d) (ci, di)
| d == ci = [(c, di)]
| otherwise = []
putStrLn $ map (dp !) s
```
## [D - Square Pair](https://atcoder.jp/contests/abc342/tasks/abc342_d)
二つ目の山場です。平方数問題。
数列 $A$ の全組み合わせを作って平方数かチェックできれば簡単ですが、それだと $O(N^2)$ で当然間に合いません。
というわけで平方数の性質を何かしら利用した計算を考える必要があります。
平方数といえば
1. 平方数は割と大きな数まで生成しても調和級数計算量になりそんなにかからない
2. 平方数は素因数分解すると $36 = 2^2 3^2$ のように因数が平方数を構成する
なんかが典型です。今回はこの後者を使えばよいです。(といいつつ 1 の方向でしばらく考えていて、時間を浪費しました 🐶)
たとえば $12$ を素因数分解すると $2, 2, 3$ が出てきますが、あと $3$ が一個あれば $36$ になります。$36$ の素因数は先に見たとおり、$2^23^2$ です。
このように $A_i$ をそれぞれ素因数分解して、あと幾つ掛ければ平方数にできるかを割り出します。具体的には、指数が奇数の素因数だけを残したら幾つになるか。そして同じ素因数を欲してるものを二つ集めると、それらがちょうど $2$ 倍になって平方数になります。面白いですね。
というわけで、
- $A_i$ をすべて素因数分解して、指数が奇数の素因数だけにする
- その結果からバケットを作って $_nC_2$ にする
で OK です。
ただし、$0$ を平方数とみなすと、$0$ は何を掛けても $0$ で平方数になるので特別扱いし別途数え上げます。
- 最初に $A$ に登場する整数をバケットでまとめあげておくと、素因数分解の回数が減って、要素数が多いテストで速くなります
- $N$ 個に対して素因数分解するのには osa_k 法などによる高速素因数分解を使います。ただ、どうもこの問題は高速素因数分解がなくても通るようです。高速素因数分解なしで通している実装も見かけました
自分は、素因数分解は、化合物を分子や原子に分解して分析するようなメンタルモデルでとらえていて、整数の構造を調べたかったら素因数分解してその数を構成する素数の構造をみる···と考えています。素数はそれ以上分解できない数つまり原子に相当しますね。平方数のような特徴的な数には、特徴的な因数構造があるはず ... と考えれば答えがみえてくると思います。
```haskell
hash mf a = do
let ps = factorize mf a
product [i * k' | (i, k) <- rle ps, let k' = k `mod` 2, k' /= 0]
{-# INLINE hash #-}
main :: IO ()
main = do
n <- getInt
as <- getInts
let mf = minFactorSieve (2 * 10 ^ 5)
bucket = toBucket (0, 2 * 10 ^ 5) as
bucket' = accumMap (+) 0 [(hash mf a, k) | (a, k) <- assocs bucket, a /= 0, k /= 0]
z = bucket ! 0
zx = nc2 z + z * (n - z)
print $ zx + sum (Map.map nc2 bucket')
```
## [E - Last Train](https://atcoder.jp/contests/abc342/tasks/abc342_e) (upsolve)
$N$ を自分の最寄り駅とみたときに、各駅の終電は何時? に答える問題ですね。
実用的な問題で面白いなと思いましたが、その分、入力されるパラメータの種類が多いのがやや厄介ですね。
本戦でもじっくり取り組みたかったです。
もとい $N$ の終点に辿り着くには、遅くとも何時の電車に乗ればいいか? なので、終点から始点に対して逆算して、各駅で遅くとも何時の電車にのれば間に合うかを考えていけばよさそう。$N$ からのダイクストラ法です。
グラフを逆向きに作ります。
各頂点には、最終的に、この問題の要求している $f(S)$ つまり最終列車の時刻が入るようにします。
頂点 $N$ からは電車には乗らないため値は $\infty$ とおきます。
![[スクリーンショット 2024-02-25 17.14.50.png|600]]
ダイクストラ法の初回の遷移を考えてみます。
$N$ から遷移できる二つの頂点の値を決めていくわけですが、それぞれの頂点から $N$ に対して向かう列車が出発する時刻が決まっています。その範囲は $t = l_i$ から $t = l_i + (k_i - 1) d_i$ と問題設定で決められています。
具体的な値にすると以下のようになります。
![[スクリーンショット 2024-02-25 17.14.57.png|500]]
頂点 $N$ からはもう電車は乗らないわけですが、仮に頂点 $N$ からも電車に乗るとしてそのもっともギリギリな時刻が先に設定した $\infty$ だとみなした場合、手前の頂点からはその $\infty$ までに間に合う時刻の時間の電車に乗ればよろしい。上記の例だと、一番遅い出発時刻で問題ないのでそれぞれ上界の $60$ と $17$ に決まります。
この、ある頂点から遷移できる先の頂点に対して配るコストの計算が、この問題のキモですね。
結論から書くと、二分探索で実装しました。
上界の時刻を `s` としたときにパラメータ $l_i$ $d_i$ $k_i$ から、それに間に合う電車の時刻を割り出します。
```haskell
resolve :: Int -> Int -> Int -> Int -> Int
resolve l d k s = do
let (ok, _) = bisect2 (0, k + 1) (\x -> l + (x - 1) * d <= s)
if ok == 0
then minBound
else l + (ok - 1) * d
```
```haskell
*Main> resolve 15 5 10 (maxBound - 7)
60
```
この関数を使うことで、$N$ から始点に向かって逆向きにダイクストラ法をしていけば各駅での終電の時間が求まります。
ダイクストラ法の緩和では最大の値を残したいので、min ヒープではなく max ヒープを使います。
また、最終結果が初期値のままの駅からはどの終電に乗っても $N$ には辿り着けない、つまり `Unreachable` になります。
```haskell
resolve :: Int -> Int -> Int -> Int -> Int
resolve l d k s = do
let (ok, _) = bisect2 (0, k + 1) (\x -> l + (x - 1) * d <= s)
if ok == 0
then minBound
else l + (ok - 1) * d
dijkstra' :: (Hashable.Hashable v, Ix v) => (v -> [(v, (Int, Int, Int, Int))]) -> (v, v) -> [(v, Int)] -> UArray v Int
dijkstra' nextStates b v0s = runSTUArray $ do
dist <- newArray b minBound
for_ v0s $ \(v, w) -> do
writeArray dist v w
let queue = HashPSQ.fromList $ map (\(v, w) -> (v, negate w, ())) v0s
aux queue dist
return dist
where
aux queue dist = case HashPSQ.minView queue of
Nothing -> return ()
Just (v, dv_, (), queue') -> do
let dv = negate dv_
let us = filter (inRange b . fst) (nextStates v)
queue'' <- foldForM queue' us $ \q (u, (l, d, k, c)) -> do
du <- readArray dist u
let dv' = resolve l d k (dv - c)
if dv' > du
then do
writeArray dist u dv'
let (_, q') = HashPSQ.alter (const ((), Just (negate dv', ()))) u q
return q'
else do
return q
aux queue'' dist
main :: IO ()
main = do
[n, m] <- getInts
xs <- replicateM m getInts
let uvs = [((v, u), (l, d, k, c)) | [l, d, k, c, u, v] <- xs]
g = wGraph (1, n) uvs
dist = dijkstra' (g !) (bounds g) [(n, maxBound)]
for_ [1 .. n - 1] $ \v -> do
if dist ! v == minBound
then putStrLn "Unreachable"
else print $ dist ! v
```
この問題の場合ダイクストラ法を単一始点最短経路を割り出す探索アルゴリズムとして捉えるのではなく、どちらかというと DP のように、現在地を踏み台に次の状態遷移先の値を決めていくフレームワークだと捉えるほうがしっくりきますね。これまたダイクストラ法をどういうメンタルモデルで解釈するか、という話だと思います。
この問題では典型的なダイクストラ法に加えて
- 最小ではなく最大方向への最適化 (min ヒープではなく max ヒープを使う)
- 辺のコストが静的に決まっておらず、その時点での頂点の値から動的に計算する
という2点の拡張が必要でした。自分の盆栽はその両者の拡張に対して開いておらず、ダイクストラ法を直接変更する必要があっていまいちです。
特に後者のようなカスタマイズが必要になる問題は、過去問でも何度かやったことがあります。この拡張に対して開いたインタフェースへの改善が必要そう。そうしておかないと、本戦中にダイクストラ法の改造の方に認知エネルギーを取られてしまって、解けるものも解けません。
----
## 感想など
995 だったレートが 1008 になりました。直近の目標だった 1000 を超えて、4桁になりました。
![[スクリーンショット 2024-02-25 18.21.27.png]]
いよいよ次の目標は水色です。
しかし、自分がコンテストに出るようになった一年弱前に比較しても、みなさんのレベルも上がってきていてもはや緑問題を安定的に解けるだけでは水色パフォーマンスを取るのも難しくなってきています。今回も緑問題を解くことが出来ましたが、水色には届かず。
水色の問題をそこそこの確率で解けてこそ水色コーダー、といわけですかね。
それにはまだもう少し時間がかかりそうですが、引き続きコツコツとやっていきたいと思います。
まずはダイクストラ法のライブラリ改造です。
----
# おまけ Haskell 精進記録
ついでなので、前回からこの一週間の精進で作った盆栽や学んだことなどの振り返りもしておこうと思います。
## AtCoder Daily Training Medium より
最近は ADT Medium をなるべく全部バーチャル参加するようにしてます。その中から学びのあった問題。
### [G - Match or Not](https://atcoder.jp/contests/adt_medium_20240220_1/tasks/abc287_d)
ABC334 C - Socks 2 でも出た、両側から累積演算する問題。toyboot 先生も日記に書いていましたが、両側系は「群」を感じながら解きたいところ。
この問題の場合、両側からみていって入力と一致する部分文字列はどこまでかを割り出すわけですが、その累積演算の結合として `(&&)` を使うと綺麗に書ける。両側から挟んで同値性をみる問題は結構ありますが、このイディオムは覚えておきたい。
```haskell
match '?' _ = True
match _ '?' = True
match x y = x == y
main :: IO ()
main = do
s <- getLine
t <- getLine
let d = length s - length t
let pre = scanl' (&&) True $ zipWith match s t
post = scanr (&&) True $ zipWith match (drop d s) t
res = zipWith (&&) pre post
for_ res $ \x -> do
printYn x
```
### [D - Coloring Matrix](https://atcoder.jp/contests/adt_medium_20240220_2/tasks/abc298_b)
配列を問題の指示通りに回転して、その回転後の配列が、もう一つ別の配列の「部分配列」になっているか?
Map には `isSubmapOfBy` という、マップの部分一致を調べられる関数があって便利。これの IArray 版 `isSubArrayOfBy`を作った。
```haskell
f 1 1 = True
f 0 _ = True
f _ _ = False
main :: IO ()
main = do
n <- getInt
gridA <- getIntGrid ((1, 1), (n, n))
gridB <- getIntGrid ((1, 1), (n, n))
let gs = take 4 $ iterate rotateGrid gridA
printYn $ or [isSubArrayOfBy f a gridB | a <- gs]
```
### [E - Yamanote Line Game](https://atcoder.jp/contests/adt_medium_20240220_2/tasks/abc244_c)
苦手なインタラクティブ問題、の中では簡単なやつ。練習にちょうどいい。
出力を flush するの忘れて TLE をもらいがちなので `printFlush` 関数を作った。
あと、この問題はイベントループ (無限再帰) を回す必要があるが `flip fix` で書くと名前を付ける必要がなくて良い。
```haskell
main :: IO ()
main = do
n <- getInt
let s = IS.fromList [2 .. 2 * n + 1]
printFlush (1 :: Int)
flip fix s $ \loop acc -> do
i <- getInt
when (i == 0) exitSuccess
let (j, acc') = IS.deleteFindMin $ IS.delete i acc
printFlush j
loop acc'
```
### [G - Step Up Robot](https://atcoder.jp/contests/adt_medium_20240220_2/tasks/abc289_d)
いわゆる蛙跳びDP。拙作の accumArrayDP 同様に使える `linearDP` という関数を作って状態遷移の記述だけに思考を集中できるようにした。
以前から実装はしてあったがインタフェースを調整して、使いやすくした。
```haskell
main :: IO ()
main = do
_ <- getInt
as <- getInts
_ <- getInt
bs <- getInts
x <- getInt
let bs' = accumArray @UArray (||) False (0, x) $ map (,True) bs
dp = linearDP @UArray f (||) False (0, x) [(0, True)] (0, x - 1)
where
f _ False = []
f i True
| bs' ! i = []
| otherwise = [(i + a, True) | a <- as]
printYn $ dp ! x
```
### [E - Error Correction](https://atcoder.jp/contests/adt_medium_20240221_2/tasks/abc324_c)
先にみた両側から挟んで `(&&)` のイディオムが早速登場
```haskell
solve s t
| s == t = True
| n == m = countBy (== False) (zipWith (==) s t) == 1
| n < m && m - n == 1 = do
let pre = scanl1 (&&) $ zipWith (==) s t
post = scanr1 (&&) $ zipWith (==) s (tail t)
countBy (== True) pre + countBy (== True) post >= m - 1
| n > m && n - m == 1 = do
let pre = scanl1 (&&) $ zipWith (==) s t
post = scanr1 (&&) $ zipWith (==) (tail s) t
countBy (== True) pre + countBy (== True) post >= m
| otherwise = False
where
n = length s
m = length t
main :: IO ()
main = do
(n, t) <- auto @(Int, String)
ss <- replicateM n getLine
let res = [i | (i, si) <- zip [1 :: Int ..] ss, solve si t]
print $ length res
printList res
```
### [G - A Piece of Cake](https://atcoder.jp/contests/adt_medium_20240221_2/tasks/abc304_d)
Map でバケットを作る必要がある問題。Map でバケットを作る時は `Map.fromListWith (+)` でもよいが、値の初期値に `[]` とか `IntSet.empty` みたいな構造的なものを使おうとすると `Map.alter` を使う必要が出てきて、慣れてなくて慌てる。
そこで使い慣れた `accumArray` 同様に使える `accumMap` と `accumIntMap` を用意した。
```haskell
main :: IO ()
main = do
[w, h] <- getInts
n <- getInt
ps <- replicateM n getTuple
a <- getInt
as <- getInts
b <- getInt
bs <- getInts
let xs = IS.fromList $ 0 : as
ys = IS.fromList $ 0 : bs
bucket = accumMap (+) 0 $ map (,1 :: Int) [(fromJust $ IS.lookupLE x xs, fromJust $ IS.lookupLE y ys) | (x, y) <- ps]
res = Map.elems bucket
if length res == (a + 1) * (b + 1)
then printList [minimum res, maximum res]
else printList [0, maximum res]
```
そういえば Map が Foldable なことを忘れがち。
`Map.elems` は必要ない。あと Maybe のままキーに入れても問題ないので番兵もいらないな。
```haskell
main = do
{-- (snip.) --}
let xs = IS.fromList as
ys = IS.fromList bs
bucket = accumMap (+) 0 [((IS.lookupLE x xs, IS.lookupLE y ys), 1 :: Int) | (x, y) <- ps]
if Map.size bucket == (a + 1) * (b + 1)
then printList [minimum bucket, maximum bucket]
else printList [0, maximum bucket]
```
### [C - 3-smooth Numbers](https://atcoder.jp/contests/adt_medium_20240222_1/tasks/abc324_b)
これはコードの書き方というよりメンタルモデルに関して。$N = 2^x3^y$ が成立する? という問題だが、これも今回 ABC342 の D 問題同様、因数を化合物の分子みたいな「モノ」としてとらえると自分の場合はしっくりくる。
割り算というのはその因数を一つ削り取る操作。削るだけ削っていって単位元が残るということは、分子がそれしかなかったということ。
```haskell
main :: IO ()
main = do
n <- getInt
let a = until (\x -> x `mod` 2 /= 0) (`div` 2) n
b = until (\x -> x `mod` 3 /= 0) (`div` 3) a
printYn $ b == 1
```
### [G - Cylinder](https://atcoder.jp/contests/adt_medium_20240222_1/tasks/abc247_d)
ABC335 C - Loong Tracking で Data.Sequence を使いこなせなかった反省をもとに、もっと手続き的なメンタルモデルで使える API を自分で用意した。それが役に立った。`pushBackSeq` や `pushFrontSeq` `popFrontSeq` など。関数名は cojna さんの `Data.Buffer` を参考にした。
おかげで、Data.Sequence を両端操作が $O(1)$ で可能なコンテナ ··· 動的型付け言語の配列的なリストのように使いたいときに、スムーズに使える。
```haskell
loop (acc, remain) deq
| Seq.null deq = (acc, deq)
| remain - c >= 0 = loop (acc + x * c, remain - c) deq'
| otherwise = (acc + x * remain, pushFrontSeq (x, c - remain) deq')
where
Just ((x, c), deq') = popFrontSeq deq
main :: IO ()
main = do
q <- getInt
qs <- replicateM q getInts
foldForM_ Seq.empty qs $ \deq query -> do
case query of
[1, x, c] -> return $ pushBackSeq (x, c) deq
[2, c] -> do
let (acc, deq') = loop (0, c) deq
print acc
return deq'
_ -> error "!?"
```
### [F - Choose Elements](https://atcoder.jp/contests/adt_medium_20240222_3/tasks/abc245_c)
この問題からの学びはかなりあってよかった。Functor, Applicative, Monad のいわゆるモナド三兄弟の解像度が上がった。
もともとはこういう DP の実装で解いた。
```haskell
data AB = A | B deriving (Show, Eq, Ord, Ix)
main :: IO ()
main = do
[n, k] <- getInts
as <- getInts
bs <- getInts
let xs = zip as bs
let dp = accumArrayDP @UArray f (||) False (A, B) [(A, True), (B, True)] $ zip xs (tail xs)
where
f (_, False) _ = []
f (A, True) ((a1, _), (a2, b2)) =
case (abs (a1 - a2) <= k, abs (a1 - b2) <= k) of
(True, True) -> [(A, True), (B, True)]
(True, False) -> [(A, True)]
(False, True) -> [(B, True)]
(False, False) -> []
f (B, True) ((_, b1), (a2, b2)) =
case (abs (b1 - a2) <= k, abs (b1 - b2) <= k) of
(True, True) -> [(A, True), (B, True)]
(True, False) -> [(A, True)]
(False, True) -> [(B, True)]
(False, False) -> []
printYn $ dp ! A || dp ! B
```
が、なんか状態遷移の場合分けが多すぎる。
そもそもたかが二値の状態遷移なので `accumArrayDP` を使わなくても `foldl'` で素直に書けば良いでしょうと、Maybe に対する論理和のアナログである `(<|>)` を使った。これで `Nothing` が返る可能性のある関数を、if 文に対する `||` かのように短絡評価できる。
```haskell
dist k x1 x2 = bool Nothing (Just x2) $ abs (x1 - x2) <= k
main :: IO ()
main = do
[n, k] <- getInts
as <- getInts
bs <- getInts
let xs = zip as bs
(a', b') = foldl' f (bimap Just Just (head xs)) (tail xs)
where
f (Just a, Just b) (ai, bi) = (dist k a ai <|> dist k b ai, dist k a bi <|> dist k b bi)
f (Just a, Nothing) (ai, bi) = (dist k a ai, dist k a bi)
f (Nothing, Just b) (ai, bi) = (dist k b ai, dist k b bi)
f (Nothing, Nothing) _ = (Nothing, Nothing)
printYn $ isJust (a' <|> b')
```
が、X で @excelspeedup さんがそもそもこの問題は非決定計算で解ける典型例ではないか、と教えてくれた。
たしかにこの計算は、$[A_i, B_i]$ の二つの値の選択可能性があって、それに対して $[A_{i+1}, B_{i+1}]$ の次の二つの値の選択可能性があり、その直積を計算して次の可能性を求める... という問題だと考えられる。
```haskell
choose k prev next = nub . concatMap (\[a, b] -> [b | abs (a - b) <= k]) $ sequence [prev, next]
main :: IO ()
main = do
[_, k] <- getInts
as <- getInts
bs <- getInts
let xs = zipWith (\a b -> [a, b]) as bs
res = foldl' (choose k) (head xs) (tail xs)
printYn $ (not . null) res
```
たしかに、リストを非決定計算の文脈でとらえたら、うまく書けた。
でも、sequence したあとに concatMap したりしてるあたりが、なんというか構造の変換を自前で書いてる感じがして手続き的な匂いがする。
これは一般化したらもっと綺麗に書けないの? というところから疑問が出発。
seqence でやってることは、二つの可能性の直積を取っている。となれば `liftA2` だなあと。
```haskell
> liftA2 (,) [1, 2] [3, 4]
[(1,3),(1,4),(2,3),(2,4)]
```
ようするにこれはアプリカティブスタイルである。
```haskell
> (,) <
gt; [1, 2] <*> [3, 4]
[(1,3),(1,4),(2,3),(2,4)]
```
というわけで、こうだ!
```haskell
choose k prev next = nub . catMaybes $ (\a b -> if abs (a - b) <= k then Just b else Nothing) <gt; prev <*> next
main :: IO ()
main = do
[_, k] <- getInts
as <- getInts
bs <- getInts
let xs = zipWith (\a b -> [a, b]) as bs
res = foldl' (choose k) (head xs) (tail xs)
printYn $ (not . null) res
```
ここで「**あれ、モナドに対する論理和が `<|>` だったところ論理積が `<*>` じゃないか**」という対比に気がつく··· ! `<*>` の `*` は一体何なんだとずっと思ってたが、そうか積なのか。
そして @kaz_yamamoto さんから
という痺れるコメント。`>>=` が掛け算、`<|>` が足し算··· !! モナド三兄弟的にはアプリカティブに分岐を加えたのがモナドであるのは既知の事実。確かに掛け算と足し算にみえるではないかー。電気が走ったような知的興奮でした。
先のコードに戻る。積を `<*>` で書けたはよかったが、アプカティブは逐次はできても分岐ができない。分岐まで含めるとやっぱり `>>=` なのである。
だが `>>=` をそのまま使うとコードとしては読みづらくなる。
```haskell
choose k prev next = nub . catMaybes $ prev >>= \a -> next >>= \b -> return $ if abs (a - b) <= k then Just b else Nothing
```
そこで do 記法であり、リスト内包表記である。
```haskell
choose k prev next = nub [b | a <- prev, b <- next, abs (a - b) <= k]
main :: IO ()
main = do
[_, k] <- getInts
as <- getInts
bs <- getInts
let xs = zipWith (\a b -> [a, b]) as bs
res = foldl' (choose k) (head xs) (tail xs)
printYn $ (not . null) res
```
めちゃくちゃ普通なコードに戻ってきた。
が、ここまでにみてきたとおり、このリスト内包表記には非決定計算の文脈、可能性の組み合わせ (積)、計算の一般化 ··· 逐次 (アプリカティブ) と分岐 (モナド) がすべて含まれている。めちゃくちゃ普通なコードで、非決定計算ができていることに意味がある。すごい。私は感動した。
## ほか
水色下位の問題を中心に解き直しをしている。
### [E - Traveling Salesman among Aerial Cities](https://atcoder.jp/contests/abc180/tasks/abc180_e)
ビットDP のとき、ビット列を集合とみなして使うわけだが `Data.Bits` の API をそのまま使うと、集合を操作しているという気持ちなのに記述するコードはビット演算なのでメンタルモデルが乖離していて、認知負荷が高い。
そこで `newtype BitSet = BitSet Int` な型を作り `Set` や `IntSet` 同様のインタフェースを持った `BitSet` を作った。`Ix` を derive しているので配列の索引に載せられる。
```haskell
cost :: (Int, Int, Int) -> (Int, Int, Int) -> Int
cost (a, b, c) (p, q, r) = abs (p - a) + abs (q - b) + max 0 (r - c)
main :: IO ()
main = do
n <- getInt
xs <- replicateM n getTuple3
let vs = listArray @Array (1, n) xs
let dp = accumDP @UArray f min maxBound ((1, emptyBS), (n, fullBS n)) [((1, singletonBS 1), 0)] [1 .. n - 1]
where
f ((v, bits), x) _
| x == maxBound = []
| otherwise =
[ ((u, insertBS u bits), x + cost (vs ! v) (vs ! u))
| u <- [2 .. n],
notMemberBS u bits
]
print $ minimum [dp ! (v, fullBS n) + cost (vs ! v) (vs ! 1) | v <- [2 .. n]]
```
### [D - Peaceful Teams](https://atcoder.jp/contests/abc310/tasks/abc310_d)
同じくビットDP の問題。冪集合の補集合を使う必要があるが BitSet のおかげで自分のメンタルモデルに合致したまま書けて最高。
```haskell
isNG forbidden s = any (\(u, v) -> memberBS u s && memberBS v s) forbidden
main :: IO ()
main = do
[n, t, m] <- getInts
xs <- replicateM m getTuple
let dp = accumArrayDP @UArray f (+) (0 :: Int) (emptyBS, fullBS n) [(emptyBS, 1)] [0 .. t - 1]
where
f (_, 0) _ = []
f (s, v) ti = do
-- たとえば 1100 + 0011 = 1111 と 0011 + 1100 = 1111 はこの問題では区別しない
-- その時点のチーム数で割る
let v' = if ti > 0 then v `div` ti else v
[(s `unionBS` s', v') | s' <- complementPowersetBS (fullBS n) s, not (isNG xs s')]
print $ (dp ! fullBS n) `div` t
```
以上、ここ一週間ぐらいの振り返り。
こうして整理することで学びが更に一段深くなる気がする。次回以降も続けるかどうかは未定。