ABC299 A～E+G をHaskellで

Fだけ解説を見てもなんだか分からないので、追記予定にします。

A - Treasure Chest

問題 ABC299A

シグネチャを決める。

abc299a :: Int    -- N
        -> String -- S
        -> Bool   -- 答え

|はちょうど二つあるので、両側からそれを見つけるまで切り落とし、残った範囲に * があるかを判定すればよい。

結果

abc299a _n =
  elem '*' .              -- 4.そこに '*' があるか
  takeWhile ('|' /=) .    -- 3.右の '|' までを取り出して
  tail .                  -- 2.それも捨てて
  dropWhile ('|' /=)      -- 1.左の '|' までを捨てて

B - Trick Taking

問題 ABC299B

シグネチャを決める。

abc299b :: Int    -- N
        -> Int    -- T
        -> [Int]  -- Ci
        -> [Int]  -- Ri
        -> Int    -- 答え

両方の勝利条件に当てはまるプレイヤー番号を、定義どおりに求めればよい。
前者は不在の可能性もあるが、後者は少なくともプレイヤー1は候補に残る。

結果

abc299b n t cs rs
  | null cand1s = getWinner cand2s
  | otherwise   = getWinner cand1s
  where
    getCands col = [ri | (c, ri) <- zip cs $ zip rs [1..], c == col]
    cand1s = getCands t
    cand2s = getCands (head cs)
    getWinner = snd . maximum

C - Dango

問題 ABC299C

シグネチャを決める。$S$が長いのでByteStringを用いる。

import qualified Data.ByteString.Char8 as BS

abc299c :: Int            -- N
        -> BS.ByteString  -- S
        -> Int            -- 答え

Sには-とoしか現れないので、groupを用いて同じものの並びにできる。
基本的には、その中で最長のoの列の長さが答えである、が、

• 例2のように全てが-のとき、つまりダンゴが一つもないとき
• 全てがダンゴで、-が一つもないとき、つまり最長のものの長さが$N$になるとき

は-1を返す必要がある。

結果

abc299c n s
  | null cands = -1
  | ans == n   = -1
  | otherwise  = ans
  where
    cands = map BS.length $ filter (('o' ==) . BS.head) $ BS.group s
    ans = maxmum cands

D - Find by Query

問題 ABC299D

$S$ の内容は無制限で、わずか20回では0と1の境界を見つけるのは困難に見える。
ただし、$S_1 = 0, S_N = 1$ だけは保証されている。
そこで、$S$が単調増加だと勝手に仮定してみる。
もしそうなら、二分法で$O(\log N)$回で境界を発見できる。
そして実際、中間点が$0$のとき、
$[S_L,\dots,S_M,\dots,S_R] = [0, \dots, 0, \dots, 1]$
となっているとき、中間点より右側には、どこかに一つは境界があるはずである。（両端が違うから）
同様に、中間点が$1$のとき、
$[S_L,\dots,S_M,\dots,S_R] = [0, \dots, 1, \dots, 1]$
となっているとき、中間点より左側に、一つは境界があるはずである。

無視する反対側は、ずっと一定かもしれないし、境界が2つあるかもしれないが、確実性はないので捨ててしまう。

結果

import System.IO

main = readLn >>= loop 1

loop l r
  | l == m    = putStrLn $ "! " ++ show l
  | otherwise =
  do
    putStrLn $ "? " ++ show m
    hFlush stdout
    si <- readLn
    if si == 1 then loop l m else loop m r
  where
    m = div (l + r) 2

E - Nearest Black Vertex

問題 ABC299E

シグネチャを決める。
答えは、NoまたはYesと改行まで含めた出力文字列とする。

abc299e :: Int          -- N
        -> Int          -- M
        -> [(Int,Int)]  -- ui,vi
        -> Int          -- K
        -> [(Int,Int)]  -- pi,di
        -> String       -- 答え

ふたつめの条件から、それぞれの頂点$p_i$について、そこから距離$d_i$未満の頂点は全て白である必要がある。
頂点ごとに、幅優先探索でそのような頂点集合を取り出すのはそれぞれ$O(N)$かかるので、全体では$O(KN)$かかる。
それらの和集合な、白くするべき頂点集合$W$を求める。

このとき同時に、$p_i$からちょうど距離$d_i$な位置にある頂点の集合$B_i$もそれぞれ求めておく。

$B_i$のうち、$W$に含まれないものを、$i$ごとに少なくとも一つ選んで黒くすれば、求められる塗り分けを達成できる。
しかし、$B_i$が全て$W$に含まれてしまうような$i$がある場合は失敗となる。
これは、$i$ごとに1つだけ頂点を選び、その結果が$K$個になったかどうかで判断できる。

さらなる例外として、例3のように、元々$K=0$のとき、この方法では塗るべき頂点を一つも選定でぎない。
ひとつめの条件より、全て真っ白ではいけない。
そのような場合は、$\overline{W}$ が空でなければ、そのうち一つでも黒くすればよい。

結果

import qualified Data.IntSet as IS
import Data.Array

abc299e :: Int -> Int -> [(Int,Int)] -> Int -> [(Int,Int)] -> String
abc299e n m uvs k pds
  | k == 0        = "Yes\n" ++ ans0
  | length v2 < k = "No"
  | otherwise     = "Yes\n" ++ ans
  where
    -- いつもの無向グラフ
    g = accumArray (flip (:)) [] (1,n) [p | (u,v) <- uvs, p <- [(u,v),(v,u)]]
    -- piから距離di未満と、ちょうどの頂点集合を求める
    nodeOfDist (pi,di) = loop di IS.empty (IS.singleton pi)
    loop 0 v1 v2 = (v1, v2)
    loop d v1 v2 = loop (pred d) v11 v21
      where
        v11 = IS.union v1 v2
        v21 = IS.fromList [w | v <- IS.elems v2, w <- g ! v, IS.notMember w v11]
    (v1s, v2s) = unzip $ map nodeOfDist pds
    -- v1 : W, v2s : Bi
    v1 = IS.unions v1s
    -- BiからWに含まれないものを1つだけずつ選ぶ
    v2 = concat [take 1 [v | v <- IS.elems v2, IS.notMember v v1] | v2 <- v2s]
    -- K>0のとき、v2の要素を黒にする
    ans = elems $ accumArray (flip const) '0' (1,n) [(v,'1') | v <- v2]
    -- K=0のとき、V-Wを全て黒にする
    ans0 = elems $ accumArray (flip const) '0' (1,n) [(v,'1') | v <- [1..n], IS.notMember v v1]

G - Minimum Permutation

問題 ABC299G

シグネチャを決める。
答えは、NoまたはYesと改行まで含めた出力文字列とする。

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

順列の辞書順で、最小のものは昇順の列である。
ここから、大きな値が前の方に来てしまうものほど大きくなる。

それぞれの数値について、$A_i$のどこに出現しているかを拾っておく。
全ての数値は、それらのどこかで出力する必要がある。これをなるべく、昇順の列に近づけたい。

そこで、全体の方針として、前から調べて、まだ猶予のある（以降にまだ出現がある）数はキープリストにとっておき、猶予がない数に遭遇したとき、キープリストにある数を吐き出す、を繰り返すことを考える。

遭遇した、猶予のない数を$X$とする。キープリストに保留された数のうち、$X$より小さいものは、$X$より前に吐き出すことで、結果の列をより小さくできる。$X$より大きいものは、もっと後回しにするべきである。

つまり、キープリストも単なるリストでなく、猶予のある数$Y$に遭遇したとき、キープリストの$Y$より大きいものは全て捨て、末尾に$Y$を追加すればよい。これは昇順のリストになる。さらに言えば整数集合で表現できる。

例外的な場合として、キープリストに既に含まれている数$Z$に再度遭遇する場面を考えておく必要がある。
これがなお猶予のある出現であるならば、全く無視してよい。キープリストを$Z$で切り詰めると損をする。
これが猶予のない出現であるときは、無視してはいけない。次の数が$Z$より小さいとき、キープリストから$Z$が追い出され、出力される機会を失ってしまう。
通常の場合のように、キープリストの全てを出力するのも誤りである。$Z$以下の値については出力するべきだが、$Z$を超える値は、まだ猶予があるものなので、後回しにできる。ここで、$Z$の以前の出現から現在位置までに、$Z$未満の値は一つもない（もしあったなら、そのときにキープリストはその値以下に切り詰められている）ことから、$Z$を超える値をキープリストに残して続行することで、$Z$の以前の出現位置で吐き出しを行い、そこから続行したのと同じ結果が得られる。

結果

import qualified Data.IntSet as IS
import Data.Array
import Data.Maybe

abc299g :: Int -> Int -> [Int] -> [Int]
abc299g n m as = loop one2n IS.empty $ zip as [1..]
  where
-- 値ごとの、出現位置集合の配列
    posA = fmap IS.fromList $ accumArray (flip (:)) [] (1,n) $ zip as [1..]
-- まだ出力していない数集合の初期値
    one2n = IS.fromAscList [1..n]
    loop :: IS.IntSet    -- まだ出力していない数集合
         -> IS.IntSet    -- キープリスト
         -> [(Int,Int)]  -- Ai, i
         -> [Int]        -- 答えBiのリスト
    loop _ _ [] = [] -- 正しければこのときyetsもkeepsも空集合
    loop yets keeps ((a,i):ais)
      | IS.notMember a yets = loop yets keeps     ais -- 出力済みの数はスルー
      | graceful, ainkeeps  = loop yets keeps     ais -- 猶予あり、キープにあり => スルー
      | graceful            = loop yets keeps1    ais -- 猶予あり、キープになし => キープに追加
      | ainkeeps            = IS.elems keeps1 ++
                              loop yets1 ks2      ais -- 猶予なし、キープにあり => 出力し、前のAiの続きから仮想的に続行
      | otherwise           = IS.elems keeps1 ++
                              loop yets1 IS.empty ais -- 猶予なし、キープになし => 出力し、現在位置から続行
      where
        graceful = isJust $ IS.lookupGT i $ posA ! a  -- Aiは猶予あり
        (ks1, ainkeeps, ks2) = IS.splitMember a keeps -- キープリストをAi未満とAi超に分割
        keeps1 = IS.insert a ks1                      -- Aiを追加して超を除いた更新キープリスト
        yets1 = IS.difference yets keeps1