A - Saturday

問題 ABC267A

シグネチャを決める。

abc267a :: String   -- S
        -> Int      -- 答え

パターンマッチで直接答えを得る。

結果

abc267a "Monday"    = 5
abc267a "Tuesday"   = 4
abc267a "Wednesday" = 3
abc267a "Thursday"  = 2
abc267a "Friday"    = 1

B - Split?

問題 ABC267B

シグネチャを決める。

abc267b :: String   -- S
        -> Bool     -- 答え

ともかく、$S$ の先頭が '1' ならスプリットでない。

abc267b ('1':_) = False

そうでないとき、列に立っているピンがあるかないか、を並べたものを見たとき、『「ある」「ない」$\times k$「ある」』という形がどこかにあればスプリットである。

列に立っているピンがあるかないかは、それぞれの列に属するピンの状態を取り出して調べる。倒れていることを True とすると、全て倒れているかは論理積で判定できる。

bs = map ('0' ==) s
cs = map (and . map (bs !!)) [[6],[3],[1,7],[0,4],[2,8],[5],[9]]

さて、cs の中の『ある～ない～ある』のパターンの検出は、正規表現でも使えれば横着ができるのだけど、Data.Listの関数の定番の組み合わせで何とかする。

結果

import Data.List

abc267b :: String -> Bool
abc267b ('1':_) = False
abc267b s =
  case cs1 of
    False:True:False:_ -> True
    _                  -> False
  where
    bs = map ('0' ==) s
    cs = map (and . map (bs !!)) [[6],[3],[1,7],[0,4],[2,8],[5],[9]]
    cs1 = dropWhile id $ map head $ group cs

C - Index × A(Continuous ver.)

問題 ABC267C

シグネチャを決める。

abc267c :: Int     -- N
        -> Int     -- M
        -> [Int]   -- Ai
        -> Int     -- 答え

位置 $i$ からの、問題の積和が求められている状態を図にするとこんな感じ。
下の長方形は普通に $A_i$ の数列で、赤い部分 $A_i$ から $A_{i+M-1}$ までの長さ一定の区間和は尺取り法で計算できる。灰色の部分が求めたい積和。

灰色の値が求められているとして、一つ右にずらした値を作るには、赤を引くことで、各 $A_i$ の係数をちょうど1ずつ減らすことができ、特に $A_i$ は消え去る。さらに右から $A_{i+M}$ の $M$ 倍を足しこめばできあがり。
なので、区間和と平行して灰色の値を順次更新して作ることができる。

結果

abc267c n m as = maximum $ loop as bas0 acc0 (tail m as)
  where
    acc0 = sum $ zipWith (*) [1..m] as -- 積和の初期値
    bas0 = sum $ take m as             -- 区間和の初期値
-- 尺取り法で積和を更新して出力
    loop (l:ls) bas acc (r:rs) = acc : loop ls bas1 acc1 rs
      where
        bas1 = bas - l + r
        acc1 = acc - bas + m * r
    loop _ _ acc [] = [acc]

D - Index × A(Not Continuous ver.)

問題 ABC267D

シグネチャを決める。問題Cと同じである。

abc267d :: Int     -- N
        -> Int     -- M
        -> [Int]   -- Ai
        -> Int     -- 答え

問題Cから話がさらにややこしくなっているが、逆に要素数が $2 \times 10^5$ から $2000$ と劇的に減っている、というところを見るのは「競技」に特化されすぎた思考でよくない。

最終結果を大きくしたいのだから、途中結果も大きいものの方が好ましいはず。しかし、それで捨てていい候補の範囲がどこまでか？をよく考える必要がある。この問題の場合、$A$ を前から順に見て、ある位置 $j$ までの範囲で $B$ の要素を $i$ 個まで選んでいるとき、同じ $i$ どうしでの最大値を残しておけばよい。
そもそも、$B$ を新たに選ぶとき、それが何個目かを知っていないと積和が計算できない、という事情もある。

ということで、$A$ の $1$ から $j$ の範囲で $B$ を $i$ 個 $(1 \leq i \leq \min(j,M))$ 選んだときのそれぞれの最大スコアを追跡するDPを行えばよい。

結果

リスト accs は先頭から、$i=1,2,\dots$ に対する最大値を保持する。

abc267d n m as = last $ foldl step [] as
  where
    step accs a = zipWith1 max accs
                  [acc + a * i | (acc, i) <- zip (0 : accs) [1..m]]

zipWith1 :: (a->a->a) -> [a] -> [a] -> [a]
zipWith1 f (a:as) (b:bs) = f a b : zipWith1 f as bs
zipWith1 _ as [] = as
zipWith1 _ [] bs = bs

標準の zipWith は、要素数の少ない方で結果を切り上げるが、ここでは accs よりも今回の a を使った結果の方が長くなるので、余った要素はそのまま続ける亜種が必要になる。

E - Erasing Vertices 2

問題 ABC267E

シグネチャを決める。

abc267e :: Int -> Int    -- N,M
        -> [Int]         -- Ai
        -> [(Int,Int)]   -- Ui,Vi
        -> Int           -- 答え

$A_i$は正の値なので、頂点を減らすことで、その頂点と接続された頂点を削除するコストは確実に減る。コストを増やしてしまうような操作はない。
つまり、作戦として、現状で最もコストの低い頂点から削除していくことで、全体のコストを下げることができるはず。

辺を調べることで、操作を行った後のコストの変動を反映させることはできる。しかし、次に削除するべきノードを特定するのに、更新されたコスト表から最小値を探すのに線形探索して $O(N)$ かけると、全体で $O(N^2)$ かかって TLE してしまう。ここをうまくやる必要がある。

ヒープ的なものに、コストを優先度、頂点番号を値とした要素を入れることで、最小値を安いコストで特定したい。しかし Data.Heap は最小値を $O(1)$ で見つけるが、内容の削除がうまくできない。Data.Set, Data.Map は最小値を得るのに $O(\log N)$ かかるが、削除や更新も同じ時間でできるので、これを使う。
複数の頂点が同じコストを持つ可能性もあるので、キーはコストだけでなく、頂点番号も対にすることで唯一性を確保する。（多重集合がないから…）

つまり、次のような情報を追跡する：

コストと頂点番号の対をもつ集合 costis：現在コスト最小の頂点を高速に選択するためのもの。頂点の削除コストが更新されるとき、この中の対応する項目も更新する必要がある。
頂点に対する現在のコストの表 costs：上の集合はこの表の逆引き表といえる。頂点を削除したときに両者を並行して更新する。頂点が削除済みかどうかのフラグも兼ねる。

コスト $c$ の頂点 $i$ を最小コストのものとして選択したとき、costs から要素 $i$ を除き、頂点 $i$ からの辺を持つすべての頂点 $j$ について、そのコストを $A_i$ だけ減らすことを costs に反映させる。
さらに、このとき変化した項目に関して、逆引き表 costis を更新する。

結果

import Data.Array
import qualified Data.IntMap as IM
import qualified Data.Set as S

abc267e :: Int -> Int -> [Int] -> [(Int,Int)] -> Int
abc267e n m as uvs = maximum $ loop costis0 costs0
  where
    aa = listArray (1,n) as                   -- Aiの配列
    edges = accumArray (flip (:)) [] (1,n)    -- 辺により、頂点iから接続される頂点のリスト
      [p | (u,v) <- uvs, p <- [(u,v),(v,u)]]
    ics = [(i, sum $ map (aa !) vs) | (i,vs) <- assocs edges]
    costs0 = IM.fromAscList ics               -- 初期コスト
    costis0 = S.fromList [(c,i) | (i,c) <- ics] -- 初期コストの逆引き表

    loop costis costs
      | S.null costis = []
      | otherwise     = c : loop costis3 costs2
      where
        ((c, i), costis1) = S.deleteFindMin costis    -- 最小値取り出し
        ai = aa ! i
        js = edges ! i
        costs1 = IM.delete i costs                    -- 頂点iは消す
        costs2 = foldl' f costs1 js -- 接続する頂点のコストをAiだけ減らす
        f im j = IM.update (Just . subtract ai) j im
        dels = [(c,j) | j <- js, Just c <- [IM.lookup j costs]]  -- jsについて
        costis2 = foldl' (flip S.delete) costis1 dels            -- 更新前の値を消す
        adds = [(c,j) | j <- js, Just c <- [IM.lookup j costs2]]
        costis3 = foldl' (flip S.insert) costis2 adds            -- 更新後の値を登録

costs2を作るときの関数 f は、削除済みの頂点のコストを負の値で復活させないようにしている。

costs をmutable vectorで実装すればより速度を稼げるが、これで充分 AC できた。

追記

「ABC267をPythonで」に

コストは優先度付きキュー内では更新されませんので、取り出したコストの情報が古ければ使わないようにしましょう。

と、ダイクストラ法にキューを持ち込む場面と同様、古い登録情報を無視するだけで、わざわざ削除する必要はないという話があったのでやってみる。なるほど。
ついでに Data.Array.ST も使ってmutableな計算にして速度を稼いでみる。Data.Set をヒープの代用にするのもやめて Data.Heap を使う。

import Control.Monad.ST
import qualified Data.Heap as H
import Data.Array.Unboxed
import Data.Array.ST
import Data.Maybe

abc267e :: Int -> Int -> [Int] -> [(Int,Int)] -> Int
abc267e n m as uvs = runST action
  where
    aa :: UArray Int Int
    aa = listArray (1,n) as                   -- Aiの配列
    edges :: Array Int [Int]
    edges = accumArray (flip (:)) [] (1,n)    -- 辺により、頂点iから接続される頂点のリスト
      [p | (u,v) <- uvs, p <- [(u,v),(v,u)]]
    cs = [sum $ map (aa !) vs | vs <- elems edges]
    costis0 = H.fromList [H.Entry c i | (i,c) <- zip [1..] cs] -- 初期コストの逆引き表

    action :: ST s Int
    action = do
      costs <- newListArray (1, n) cs :: ST s (STUArray s Int Int)
      loop costis0 costs 0

    loop :: H.Heap (H.Entry Int Int) -> STUArray s Int Int -> Int -> ST s Int
    loop costis costs acc
      | H.null costis = return acc
      | otherwise =
        do
          let Just (H.Entry c i, costis1) = H.uncons costis    -- 最小値取り出し
          ci <- readArray costs i
          if ci <= 0 then loop costis1 costs acc else do -- 処理済みなのでスルー
            let ai = aa ! i
            let js = edges ! i
            writeArray costs i 0      -- 頂点iは消す
            jcs <- forM js (\j -> do  -- 接続する頂点のコストをAiだけ減らす
              cj <- readArray costs j
              if cj <= 0 then return Nothing else do -- 生きているもの限定
                let cj1 = cj - ai
                writeArray costs j cj1
                return $ Just (j, cj1)
              )
            let costis2 = foldl (\h (j,c) -> H.insert (H.Entry c j) h) costis1 $
                          catMaybes jcs -- 更新後の値をキューに登録
            loop costis2 costs (max acc c)

Data.Array.Unboxed や ST 系のコンテナは、型を明記しないと怒られるので面倒。
でも immutable版は2.2秒超だったのが1.5秒弱になった。