ABC354 A～F をHaskellで

A - Exponential Plant

問題 ABC354A

シグネチャを決める。

abc354a :: Int -- H
        -> Int -- 答え

$i$日目の朝の植物の高さは $2^0 + 2^1 + 2^2 + \dots + 2^{i-1} = 2^i - 1 > H$, $2^i \gt H + 1$
これはABC215Bとほぼ同じ。

結果

-- 問題の内容を忠実にシミュレーションする版
abc354a h = length $ takeWhile (h >=) $ scanl (+) 0 $ iterate (2 *) 1

-- 数学的解析に基づく版
abc354a h = head [i | i <- [0..], 2 ^ i > succ h]

B - AtCoder Janken 2

問題 ABC354B

シグネチャを決める。

abc354b :: Int              -- N
        -> [(String, Int)]  -- Si,Ci
        -> String           -- 答え

めずらしく番号が0始まりになっている。
問題の内容を忠実にシミュレーションする。

結果

import Data.List

abc354b :: Int -> [(String, Int)] -> String
abc354b n scs = ss !! mod t n
  where
    ss = sort $ map fst scs
    t  = sum  $ map snd scs

C - AtCoder Magics

問題 ABC354C

シグネチャを決める。$A_i, C_i$ は横着する。

abc354c :: Int      -- N
        -> [[Int]]  -- Ai,Ci
        -> Int      -- 答え

$A_i, C_i$ はそれぞれ互いに異なり重複しないので、考えるのが楽。
カードの強さの昇順に見たとき、残すカードは、コストも昇順になっているもの。

カードの強さの降順に見ていく。
最後に残すと決めたカードのコスト $C_\max$ が、今後許されるコストの最大値となる。

次のカード $(A_i, C_i)$ を見たとき、

• $C_\max < C_i$ コストが許容されない大きさならば、そのカードは捨てる
• $C_i < C_\max$ 許されるコストならば、そのカードは残し、今後許されるコストの最大値が下方修正される

結果

acis の行は、$([A_i, C_i], i)$ という要素の並んだリストの $A_i$ の昇順でソートしている。

import Data.List
import Data.Function

abc354c :: Int -> [[Int]] -> [Int]
abc354c _n acs = sort is
  where
    acis = sortBy (flip compare `on` (head . fst)) $ zip acs [1..]
    is = loop maxBound acis
    loop _ [] = []
    loop lb ((_:c:_, i) : acis)
      | lb < c    =     loop lb acis
      | otherwise = i : loop c  acis

フレンズさんの方法

フレンズさんの解説だと、$A_i$ の昇順にスタックにpushしていくが、新しいカードを積む前に、それよりコストが高い（のに強さはしょぼい）カードがあればtopにあるので全て捨ててから、という方針になっている。

これだと、一度登録したものが後で却下される可能性があって何かなぁ、と思うけど、各要素はpush, popは一度ずつしかしないから$O(N)$なのは同じ。（ソートの $O(N \log N)$ が支配的）

abc354c :: Int -> [[Int]] -> [Int]
abc354c _n acs = tail $ sort $ map snd $ loop [(0, 0)] $ sort $ zip acs [1..]
  where
    loop cjs [] = cjs
    loop cjs ((_:ci:_, i) : acis) = loop ((ci,i):cjs1) acis
      where
        cjs1 = dropWhile ((ci <) . fst) cjs

D - AtCoder Wallpaper

問題 ABC354D

シグネチャを決める。横着する。

abc354d :: [Int]  -- A,B,C,D
        -> Int    -- 答え

示されている図をじっとにらむと、X軸方向は4ずつの繰り返し、Y軸方向は2ずつの繰り返しになっていることがわかる。それらのマスごとに、答えに足し込むべき値はそれぞれ

1 2 1 0
2 1 0 1

である。

X軸方向に4ずつ平行移動、Y軸方向に2ずつ平行移動させることで、$0 \leq A < 4$, $0 \leq B < 2$ となる位置に移動させても結果は同じである。という正規化をする。

以下、二次元累積和をこの問題について特化させて考える。

Y座標が偶数の列は面積が順に 2, 1, 0, 1 となっている。その合計は 4 である。
累積和の引き算で区間和を求める形で、0からAまでの和は [2,1,0,1] の第0～A要素の和である。
0からCまでの和は、$C \div 4 = q \dots r$ とすると $4q$ と [2,1,0,1] の第 0～r 要素の和である。
Cまでの和からAまでの和を引くと、偶数の行の値になる。これを $eL$ とする。

Y座標が偶数の列は面積が順に 1, 2, 1, 0 となっている。その合計は 4 である。
上の手順の、面積だけこれに差し替えれば、AからCまでの和が得られる。これを $oL$ とする。

同じように今度はY軸方向を考える。
$D \div 2 = q \dots r$ とすると、$q (eL + oL) + eL \cdot r$ がDまでの和である。
B=0なら引くものはなし、B=1なら $eL$ を引いて補正する。
結局 $q (eL + oL) + eL (r - B)$ が答えになる。

結果

scanl (+) 0 [2,1,0,1] = [0,2,3,3,4]
scanl (+) 0 [1,2,1,0] = [0,1,3,4,4] である。

abc354d [a,b,c,d] = ans
  where
-- 正規化
    (qx, a1) = divMod a 4
    c1 = c - 4 * qx
    (qy, b1) = divMod b 2
    d1 = d - 2 * qy
-- X軸方向
    (qx2, rx2) = divMod c1 4
    eL = - [0,2,3,3] !! a1 + 4 * qx2 + [0,2,3,3] !! rx2
    oL = - [0,1,3,4] !! a1 + 4 * qx2 + [0,1,3,4] !! rx2
-- Y軸方向
    (qy2, ry2) = divMod d1 2
    ans = (eL + oL) * qy2 + (ry2 - b1) * eL

E - Remove Pairs

問題 ABC354E

シグネチャを決める。$A_i, B_i$ は横着する。

abc354e :: Int      -- N
        -> [[Int]]  -- Ai,Bi
        -> String   -- 答え

$N \leq 18$ と小さいので、残っているカードの番号の集合をビット表現して、
これをキーとする配列に、勝者が先手なら True 後手なら False を割り当てるDPを行う。

現在が先手番か後手番かは、1のビット数をNから引いて2で割った結果の偶奇でわかる。
カードを必ず2枚ずつ捨てるからである。

局面について、表か裏いずれかの数が同じカードを2枚組で捨てた結果局面を調べて、それらの中に、自分が勝ちとなる方法が1つ以上存在するなら、その手を選択すればよいので自分の勝利、そういう方法が全くないとき、つまりどの手を選んでも自分が負けるか、そもそも捨てるカードがないような場合も含めて、自分の負け、つまり相手の勝ちと判定できる。

結果

import Data.Bits
import Data.Array
import Data.List

abc354e :: Int -> [[Int]] -> String
abc354e n abs = if arr ! all1 then "Takahashi" else "Aoki"
  where
    iabs = zip [0..] abs
    all1 = bit n - 1 :: Int
    arr = listArray (0, all1) $ map f [0 .. all1]
    f bits = if res then side else not side
      where
        side = even $ div (n - popCount bits) 2
        res = or
          [ arr ! clearBit bits1 j == side
          | (i, a:b:_):jcds <- tails iabs, testBit bits i, let bits1 = clearBit bits i
          , (j, c:d:_) <- jcds, testBit bits j, a == c || b == d]

F - Useless for LIS

問題 ABC354E

T個のテストケースは互いに独立なので、一つのテストケースについて解く関数を考える。

シグネチャを決める。

abc354e :: Int    -- N
        -> [Int]  -- Ai
        -> [Int]  -- 答え

制約の $T \leq 2 \times 10^5$, $N \leq 2 \times 10^5$ を見てぎょっとするが、最後に、$N$の総和が $2 \times 10^5$ 以下とあって安心する。

問題の要求は、数列に対してLISを考えたとき、それぞれの $A_i$ が、何らかのLISで使われることがあるかどうかを全ての項について判定せよというもの。
しかし全ての LIS を作り、チェックを入れるのは大変だ。

普通のLISは数列を前から見ていってDPで作る。
ある位置までの要素で様々な長さの上昇部分列が作れるが、その中で、ある長さのものを作るときの末尾要素の最小値を維持する。
新たな $A_i$ を見たとき、DPの表はたかだか一点でのみ更新される。（LISの復習）

さて、$A_i$ を使うLISが数列に存在するのなら、その長さを $L$ として、

• $A_i$ より左の要素だけで、末尾が $A_i$ より小さい値の上昇部分列の長さを $l_i$ として、
• $A_i$ より右の要素だけで、先頭が $A_i$ より大きい値の上昇部分列の長さを $r_i$ として、

$L = l_i + 1 + r_i$ が成り立つはずである。
この $l_i$ は、LISを求める計算の途中、$A_i$ に関する処理の中で得られる。
同様に $r_i$ も、列を右から見て LIS の逆を探す計算の途中で順に得られる。

結果

右からの下降列の長さを求める手順は、項を全てマイナスにして済ませる。

import Data.List
import qualified Data.IntMap as IM

abc354f :: Int -> [Int] -> [Int]
abc354f :: Int -> [Int] -> [Int]
abc354f _n as = [i | (i, lr) <- zip [1 ..] $ zipWith (+) ls rs, lr == pred l]
  where
    (imL, ls) = mapAccumL step (IM.singleton minBound 0) as
    (_,   rs) = mapAccumR step (IM.singleton minBound 0) $ map negate as
    (_, l) = IM.findMax imL
    step :: IM.IntMap Int -> Int -> (IM.IntMap Int, Int)
    step im ai =  -- LISを求めるステップに li を出力する機構を追加
      case IM.lookupGE ai im of
        Just (ak, _l)                            -- _l == lj + 1
          | ai < ak   -> (IM.delete ak im1, lj)
          | otherwise -> (im              , lj)  -- ai == ak
        Nothing       -> (im1             , lj)
      where
        Just (_aj, lj) = IM.lookupLT ai im
        im1 = IM.insert ai (succ lj) im

セグ木は出てこなかった。

G - Select Strings

フレンズさんいわく

アライグマ「G問題はフローで解けるらしいのだ！」
フェネック「推移的なDAGの独立集合を求める問題だからDilworthの定理で最小パス被覆になって、二部グラフの最大マッチングに帰着して最大流を求めれば解けるねー。ABC237Ex『Hakata』が類題だよ」

ネットワークフローは未履修なので今日はこの辺で失礼します。