# ABC306 振り返り
- [トヨタ自動車プログラミングコンテスト2023#3(AtCoder Beginner Contest 306) - AtCoder](https://atcoder.jp/contests/abc306)
- 成績 ABCD 4完 ··· [コンテスト成績証 - AtCoder](https://atcoder.jp/users/oceajigger/history/share/abc306) (Rated で参加したが、コンテスト自体が Unrated に)
- 前回 [[ABC305 振り返り]]
以下、キーワードリンクはローカルの内部リンクになっていて辿れません
----
## [A - Echo](https://atcoder.jp/contests/abc306/tasks/abc306_a)
- 今回の A はとても素直な問題だったので、相変わらず緊張で頭は真っ白でしたがささっと実装できました
- 各文字を倍化して繋げる
「いま、concatMap をいただきましたけどもね」「こんなんなんぼあってもいいですからね。」
```haskell
{-# LANGUAGE TypeApplications #-}
main :: IO ()
main = do
_ <- readLn @Int
s <- getLine
putStrLn $ concatMap (\c -> [c, c]) s
```
----
## [B - Base 2](https://atcoder.jp/contests/abc306/tasks/abc306_b)
- 2進数が与えられるので、10進に直します。$N$進の変換関数は懐に温めているのでそれを使う
- が、簡単すぎるので少し怪しみました。オーバーフローが気になる、かつ、計算量は全く問題ないので保険で多倍長整数 (`Integer`) にしときました
- どうやらやっぱりそこが落とし穴だったみたい
「怪しいので多倍長整数にしときましたけれども」
```haskell
import qualified Data.ByteString.Char8 as BS
import Data.Char (isSpace)
import Data.List (foldl', unfoldr)
getInts :: IO [Int]
getInts = unfoldr (BS.readInt . BS.dropWhile isSpace) <
gt; BS.getLine
fromDigits :: Integer -> [Integer] -> Integer
fromDigits n = foldl' (\acc b -> acc * n + b) 0
main :: IO ()
main = do
as <- getInts
print $ fromDigits 2 $ reverse $ map fromIntegral as
```
----
## [C - Centers](https://atcoder.jp/contests/abc306/tasks/abc306_c)
- 問題文の読解力を要求される問題でした。問題文読むの苦手マンとしては、大変エネルギーを使います
- が、問題文が読めてしまえば簡単で、整数ごとに索引を集めてきて真ん中の値を求める... と言うのが本懐。値ごとに何かする、と言うのは Haskell なら `accumArray` です。`accumArray` 大好きマンとしてはニチャりポイント
- 索引を集めて真ん中とってそれをベースにソートし直してまた索引を表示する、みたいな感じで、言葉にするとややこしいですね
```haskell
{-# LANGUAGE TypeApplications #-}
import Data.Array.Unboxed (Array, accumArray, (!))
import qualified Data.ByteString.Char8 as BS
import Data.Char (isSpace)
import Data.List (sortOn, unfoldr)
getInts :: IO [Int]
getInts = unfoldr (BS.readInt . BS.dropWhile isSpace) <gt; BS.getLine
main :: IO ()
main = do
n <- readLn @Int
as <- getInts
let as' = accumArray @Array (flip (:)) [] (1, n) $ zip as [1 :: Int ..]
xs = map (\i -> (as' ! i) !! 1) [1 .. n]
result = map snd $ sortOn fst $ zip xs [1 :: Int ..]
putStrLn . unwords . map show $ result
```
----
## [D - Poisonous Full-Course](https://atcoder.jp/contests/abc306/tasks/abc306_d)
この辺から難易度が少し上がってきます。
- 毒入り料理を続けて食べたら高橋くんが死んでしまうシチュエーションは以前にも見たきがします。なんでこんなリスクのあるお店に行くのかが不可解です。よっぽど美味しいんでしょうね
- さて、この問題ですが入力例 1 が比較的ヒントが満載で、お腹を壊している、壊していない時で選べる選択肢が違うのと、貪欲に目の前のものをチョイスするのでは最適解にならないというのがわかります。過去どういう選択をしてきたかに次の一手が依存する再帰的な構造になっており、かつ、状態空間としては毒を持ってるとき、持ってないときの二つに分かれる。と言うわけで DP です。
「ほんだら俺がね、おかんの好きなこの問題一緒に考えてあげるから、どんな特徴言うてたかとか教えてみてよ。」
「おかんが言うには、毒をもってる状態、毒を持ってない状態の二つの状態があって食べ物を都度食べるか食べないかを選択したときの最適解を求める問題らしい」
「その特徴はもう完全に DP やがな！すぐわかったよこんなもん。DP というのはな、部分問題に同じ最適化問題があるという部分構造最適性と、同じ部分問題のが繰り返し現れる部分問題重複性が成立するときに適用できるんやから。DP や絶対」
```haskell
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeApplications #-}
import Control.Monad (replicateM)
import Data.Array.IArray (accumArray, assocs)
import Data.Array.Unboxed (UArray, (!))
import qualified Data.ByteString.Char8 as BS
import Data.Char (isSpace)
import Data.List (foldl', unfoldr)
getInts :: IO [Int]
getInts = unfoldr (BS.readInt . BS.dropWhile isSpace) <gt; BS.getLine
solve :: [(Bool, Int)] -> UArray Bool Int
solve xs = do
let dp = accumArray max minBound (False, True) [(False, 0), (True, 0)]
foldl' transition dp xs
where
transition dp (xi, yi) = do
let expand = concatMap (\(flag, v) -> f (flag, v) (xi, yi)) $ assocs dp
accumArray max minBound (False, True) expand
f (False, v) (False, yi) = [(False, v), (False, v + yi)]
f (False, v) (True, yi) = [(False, v), (True, v + yi)]
f (True, v) (False, yi) = [(False, v + yi), (True, v)]
f (True, v) (True, _) = [(True, v)]
main :: IO ()
main = do
n <- readLn @Int
xs <- replicateM n $ do
[x, y] <- getInts
return (x == 1, y)
let dp = solve xs
print $ max (dp ! False) (dp ! True)
```
----
## [E - Best Performances](https://atcoder.jp/contests/abc306/tasks/abc306_e) ( コンテスト後にAC)
今回は D 問題を解いた時点でまだ残り 60分あったのでもしかしたら 5完もいけるのでは? と思ったのですがダメでした。時間切れ。
「おかんが言うにはな、2つのデータ構造を用意してそれぞれ値の重複を許しつつ最小値と最大値を少ない計算量で求められればいいらしいねん」
「おー、ヒープやないかい！ その特徴はもう完全にヒープやがな」
「いや、俺もヒープや思うてんけどな、でもこれちょっと分からへんのやな」
「何が分からへんのよ」
「おかんが言うには、そのデータ構造から指定した値を削除できる必要があるらしいんよな」
「あー、ほなヒープと違うかぁ。二項ヒープは特定の値を削除するのは苦手やからね」
トップ $K$ とそれ以外に二つにデータを分けてその最小値と最大値、つまり境界にあるデータを見ながら、入力に対応していくという基本的な解法は思いついてたのですが、多重集合ではなくヒープを使って実装していたため、削除のところでつまづいてしまいました。
あと、境界条件がなかなか難しい問題でした、実装が粗い。
Haskell には multiset 相当のデータ構造が組み込みにはないので `IntMap` で代用してなんとか AC
解説は見ずに解くことはできましたが、2時間ぐらいかけて丁寧に紐解いて行ってようやく解けたと感じなので、これを本番中に通すのは、今の自分ではまだ難しかったなあという印象でした。そして Haskell の多重集合の実装をライブラリ化しておいた方が良さそうなので、今日はこの後それに取り組みます。
```haskell
{-# LANGUAGE BangPatterns #-}
import Control.Monad (replicateM)
import Data.Bool (bool)
import qualified Data.ByteString.Char8 as BS
import Data.Char (isSpace)
import qualified Data.IntMap.Strict as IM
import Data.List (scanl', unfoldr)
getInts :: IO [Int]
getInts = unfoldr (BS.readInt . BS.dropWhile isSpace) <gt; BS.getLine
getTuple :: IO (Int, Int)
getTuple = do
[a, b] <- getInts
return (a, b)
type Context = (Int, (IM.IntMap Int, IM.IntMap Int, IM.IntMap Int))
f :: Context -> (Int, Int) -> Context
f (s, (ix, a, b)) (x, y)
-- (1) A に入り、out も A にある
| y > p && out >= p = do
let s' = s + y - out
(s', (ix', insert y (delete out a), b))
| y > q && out > q = do
let s' = s + y - out
(s', (ix', insert y (delete out a), b))
-- (2) A に入り、out は B にある -> A からあぶれたものは B へ
| y > p && out < p = do
let s' = s + y - p
(s', (ix', insert y (deleteMin a), insert p $ delete out b))
-- (4) B に入り、out は A にある -> B から A へ移す
| y <= p && out >= p && out >= q = do
let s' = s + q - out
(s', (ix', insert q (delete out a), insert y $ delete q b))
-- (3) B に入り、out は B にある
| otherwise = do
(s, (ix', a, insert y $ delete out b))
where
!p = findMin a
!q = findMax b
!out = ix IM.! x
!ix' = IM.insert x y ix
findMax :: IM.IntMap Int -> Int
findMax xs = fst $ IM.findMax xs
findMin :: IM.IntMap Int -> Int
findMin xs = fst $ IM.findMin xs
insert :: Int -> IM.IntMap Int -> IM.IntMap Int
insert x xs = do
IM.insertWith (+) x 1 xs
delete :: Int -> IM.IntMap Int -> IM.IntMap Int
delete x xs = do
IM.update (\k -> let k' = k - 1 in bool Nothing (Just k') $ k' > 0) x xs
deleteMin :: IM.IntMap Int -> IM.IntMap Int
deleteMin xs = do
IM.updateMin (\k -> let k' = k - 1 in bool Nothing (Just k') $ k' > 0) xs
main :: IO ()
main = do
[n, k, q] <- getInts
qs <- replicateM q getTuple
let ix = IM.fromList $ zip [1 .. n] (repeat (0 :: Int))
a = IM.singleton 0 k
b = IM.singleton 0 (n - k)
let xs = scanl' f (0, (ix, a, b)) qs
mapM_ print (tail . map fst $ xs)
```
----
## 感想・反省など
40分弱で D まで解けました。過去回の中では一番スムーズだった気がします。
少し前から、ストップウォッチで計測しながら問題を解くことにより、日頃から時間的プレッシャーをかけるようにしていますが、その効果が出てきているように思います。速解きに効果的というよりはメンタル的なところですね。プレッシャーがかかっているときでも、どう思考すれば良いかが経験的に少しずつ積み上がってきている気がします。
相変わらず緊張もしましたが、やはりストップウォッチ効果で、緊張の中で自分自身どう振る舞えば良いか少しづつわかってきている感じがあり、対応できるようになってきました。緊張しないのが一番良いんですが、流石にそうはいかないようです。
ところで本戦に出るようになってみて面白いなあと思うのは、自分の実力が着実に積み上がってる感じが実感できるところですね。そしてまだその実力が頭打ちにはなってないようです。
当初は「こんなことできるようになるとは思えない」と思っていたことが、少しづつの積み上げによりいつの間にかできるようになっているという繰り返しです。学生の頃にスポーツ競技をやっていてそういう感覚に至ったことはありますが、こういうのは社会人になって以降はほとんどなかったですね。プログラミングに関して、自分が何かをできるようになったタイミングですとか、何を学んだことでそれをできるようになったかは比較的はっきりしていました。競プロの場合、自分の認識できないところで過去の記憶と新しく得た記憶が結びついて知識が創発されている気配があり、練習を繰り返しているうちにいつの間にかできなかったことができるようになっているということが多くて面白いです。
そういう知識の創発を起こすのに、それが起きやすい取り組み方と言うのがあるように思います。ただ単に漠然と問題を解き続けているだけでは知識の創発は起きにくそうですが、問題を解くたび、自分がその問題を解く過程でどういう思考をしていたかを言語化するなどして、自分自身と対話を続けます。似たような問題を繰り返し解いていると、この対話を通じて過去の記憶が呼び起こされて記憶が紐付き、そこから抽象が得られて、それによりメンタルモデルがアップデートされる。そんなことを繰り返しているような気がします。
ポイントは自己との対話です。ただ単に対話するのではなく、問題を解いて帰納的な経験を得た上で、演繹的な抽象にまとめるべく、自分の中の既存のメンタルモデルと対話し、そこに新しい経験を反映していきます。
例えば今回も問題に出た DP なんかも理屈でわかっていると言うより、感覚的にわかっているステージに入ってきた感があります。「状態遷移があって、その状態が遷移する状態空間が狭く、かつ最適解が状態遷移全体をみてみないとわからないとき···」 というようなメンタルモデルが自分自身の中にありますが、おそらくこれを他人に説明してもあまり共感は得られないでしょう。このモデルは、自分が繰り返し問題を解く中で少しづつ育ててきたものなので、他の人の🧠には同じメンタルモデルが存在しない。しかし一度自分がそのメンタルモデルを通じて問題を見てみるとあら不思議「ペロッ··· これはDP!」と鼻がきくという塩梅です。
こういう感覚がどこまで伸びていくかはわかりませんが、まだ伸びしろは結構ありそうなので引き続き緑問題を解いていくなどして鍛えていこうと思います。