2
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

ABC326 A~F をHaskellで

Last updated at Posted at 2023-10-30
  • C : 尺取法
  • D : 場合を列挙する方法
  • E : 双六のDP、モジュロ逆数
  • F : 半分全列挙、尺取法、番兵

A - 2UP3DOWN

問題 ABC326A

シグネチャを決める。

abc326a :: Int  -- X
        -> Int  -- Y
        -> Bool -- こたえ

$Y$が$X - 3 \leq Y \leq X + 2$の範囲に入っているかどうか判定すればよい。

結果

abc326a x y = x - 3 <= y && y <= x + 2

B - 326-like Numbers

問題 ABC326B

シグネチャを決め…あぐねる。

問題文から素直に整数で受け取るよりも、文字列で受け取っておいてそれぞれの桁の数字で考えた方がいいような気がする。

素直なやり方

数値で受け取り、条件を満たす最初の数を見つけるまでカウントアップする。

abc326b :: Int -> Int
abc326b n = head $ filter prop [n..]

prop :: Int -> Bool
prop x = a * b == c
  where
    a = div x 100
    b = div x 10 - 10 * a
    c = mod x 10

まめなやり方

桁ごとに数字で受け取って、細かく場合分けして考える。
$N$の各桁の数字をそれぞれ$a,b,c$としたとき、

  • $c \leq a \times b \leq 9$ なら、$a,b,a \times b$という数字の並びが答え(例1,2)
  • さもなくば、 $b + 1 \leq b' \leq 9$ により $a \times b' \leq 9$ とできるなら、そのような最小のものによる $a,b',a \times b'$ が答えだが、この範囲に条件を満たすものがあるなら、$b + 1$ も条件を満たし、それが最小になるので、$a \times (b + 1) \leq 9$ ならば $a, b+1, a \times (b + 1)$ が答え、と言い換えられる(例:139に対する144)
  • さもなくば、10の位が繰り上がりで0となった$a+1,0,0$が答え(例3)
import Data.Char

abc326b :: String -> Int
abc326b s
  | c <= ab, ab <= 9 = 100 * a + 10 * b  + ab
  | ab1 < 10         = 100 * a + 10 * b1 + ab1
  | otherwise        = 100 * succ a
  where
    (a:b:c:_) = map digitToInt s
    ab  = a * b
    b1  = succ b
    ab1 = a * b1

C - Peak

問題 ABC326C

シグネチャを決める。

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

区間の左に余裕を持たせることに意味はないので、いずれかの$A_i$のぎりぎりに設定し、そのとき、$A_i+M$までにいくつ値があるかを数え、その最大値を見つける。

要素は重複しうるので、Data.IntSet による単純な集合や、IntMap による単純な多重集合ではうまくいかない。
尺取法により、区間左端の値$+M$未満の要素を可能なだけ取り込むよう区間右側を動かす。

結果

右端をオーバーランしないように番兵を置く。
loopの引数は、区間内の要素の個数、左端のリスト、右端に届きそうな要素のリスト、で、区間が伸びきって縮むたびにその瞬間の長さを放出する。右端に番兵が到着したら、そのときの長さを放出して終了する。

import Data.List

abc326c :: Int -> Int -> [Int] -> Int
abc326c _n m as = maximum $ loop 0 as1 as1
  where
    as1 = sort as ++ [maxBound] -- 番兵
    loop cnt lls@(l:ls) rrs@(r:rs)
      | r < l + m     = loop (succ cnt) lls rs
      | r == maxBound = [cnt]
      | otherwise     = cnt : loop (pred cnt) ls rrs

踊り場の機知

区間の左側用に、その数の最小の背番号を対応づけたリストを作り、区間の右側用にその数の最大の背番号を持たせたIntMapを作り、左側のそれぞれの値 $+M$ について、IntMap.lookupLT で背番号の差を取れば要素数を取り出せる。ただ、$N$回 $O(\log N)$ することになるので、全体で $O(N)$ の尺取法より遅い。(から思いついたけどやらない。)

D - ABC Puzzle

問題 ABC326D

シグネチャを決める。結果は出力形式そのままの文字列とする。

abc326d :: Int     -- N
        -> String  -- R
        -> String  -- C
        -> String  -- 答え

$3 \leq N \leq 5$ という小さな盤面での出来事。
それぞれの行や列は、"ABC.."の前から $N$ 文字をシャッフルしたものになっている。
そのうち、先頭の文字を固定したものを取り出すこともできる。
$R,C$で指定された文字が先頭になるように選び、1行めと1列めを総当たりし、それに反しないもので$R,C$の指定に合うように2行めと2列めを総当たりし、…と埋めていくと、破綻したときの手戻りが早い気がする。

結果

(*)が付いているのは重要な定義、そうでないものは補助定義。

import Data.List

abc326d :: Int -> String -> String -> String
abc326d n r c
  | null cands = "No\n"
  | otherwise  = unlines $ "Yes" : head cands
  where
-- 行や列の全ての候補
    candsBase = nub $ permutations $ take n "ABC.."
-- 文字列の空白を除いた先頭が指定した文字か判定
    headis d = (d ==) . head . dropWhile ('.' ==)
-- (*) 先頭が指定した文字な、行や列の候補
    mkCands d = filter (headis d) candsBase
-- 指定した文字の個数を数える
    count d = length . filter (d ==)
-- (*) 文字列はA,B,Cがたかだか1文字であるか(文字の重複がないか)判定
    checkabc s = all (\d -> 1 >= count d s) "ABC"
-- (*) 再帰的に解を全て取り出す
    cands = loop 0 r c [] []
-- (*) 行と列ごとに決める。
    loop _ "" "" rows _ = [rows]        -- RとCが空になったら完成
    loop k (r:rs) (c:cs) rows cols =
      [ res
      | let rowHead = map (!! k) cols  -- 決定済みの列から、k行めの前k文字を抜き出す
      , row <- mkCands r               -- 先頭がRkな候補で
      , isPrefixOf rowHead row         -- 前k文字が指定通り
      , let rows1 = rows ++ [row]      -- 決定済みの行にrowを追加
      , let colHead = map (!! k) rows1 -- 決定済みの行から、k列めの前k文字を抜き出す
      , col <- mkCands c               -- 先頭がCkな候補で
      , isPrefixOf colHead col         -- 前k文字が指定通り
      , res <- loop (succ k) rs cs rows1 (cols ++ [col]) -- 続きを再帰的に構築
      ]

解説のやり方

公式解説は、縦横を組み合わせる代わりに、行の先頭の文字だけ気にして総当たりして、列が条件を満たすかを調べている。ただし、列の条件が満たされているかは、行を追加するごとに行う。列の条件の確認が「指定したものになっているか、まだ.しか現れていない」となっていたり、妙に面倒くさい。

ユーザ解説は、各行各列にそれぞれの文字が1つずつある置き方の場合が結局、$120^3$より小さい程度なのでそれを総当たりで生成して、行と列について条件を満たすものかを確認している。Pythonのitertoolsの強力さが光る。写経しておく。

abc326d :: Int -> String -> String -> String
abc326d n r c
  | null cands = "No\n"
  | otherwise  = unlines $ "Yes" : head cands
  where
    npn = permutations [1..n]
    g i c h = \j -> if j == i then c else h j
    cands =
      [ rows
      | as <- npn
      , bs <- npn, and $ zipWith (/=) as bs
      , cs <- npn, and $ zipWith (/=) as cs, and $ zipWith (/=) bs cs
      , let rows = [map (g i 'A' $ g j 'B' $ g k 'C' $ const '.') [1..n] | (i,j,k) <- zip3 as bs cs]
      , r == map (head . dropWhile ('.' ==)) rows
      , c == map (head . dropWhile ('.' ==)) (transpose rows)
      ]

性能は匹敵する上に、コードがとてもシンプル。計算量の見積もりができなければ、この方針に舵を切ることができない。

E - Revenge of "The Salary of AtCoder Inc."

問題 ABC326E

シグネチャを決める。

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

考える

結局これはスゴロクの変形になっている。

今回のダイスの目が$k$のときに、$A_k$を含めて、これ以降に得る給料総額の期待値を$B[k]$とする。
$N$を出すと次は絶対に終わりなので、$B[N]=A_N$と決まる。
それ以外の場合、まず$A_k$を得て、次に、$1$~$k$が出たら終わり、さもなくば$1/N$の確率でそれぞれ$B[k+1]$~$B[N]$を得るので、$\displaystyle B[k] = A_k + \frac{1}{N} \sum_{j=k+1}^N B[j]$ となる。最終的な答えは $\displaystyle \frac{1}{N} \sum_{j=1}^N B[j]$となる。Σは後ろから累積和で求めると早い。

abc326e n as = ans
  where
    recipn = modRecip n
    ans:ss = map (mul recipn) $ scanr add 0 bs
    bs = zipWith add as ss

しかし遅延評価はこの依存関係を解決できない。

遅延配列で実装する。

import Data.Array

abc326e :: Int -> [Int] -> Int
abc326e n as = mul recipn $ sigs ! 0
  where
    recipn = modRecip n
    sigs = listArray (0,n) $ [ bs ! i + sigs ! i | i <- [1 .. n] ] ++ [0]
    bs = listArray (1,n) [ai + mul recipn (sigs ! i) | (i, ai) <- zip [1..n] as ]

これは動いたが、配列を二つ確保するのが気になる。bssigsの定義に押し込む。

abc326e :: Int -> [Int] -> Int
abc326e n as = mul recipn $ sigs ! 0
  where
    recipn = modRecip n
    sigs = listArray (0,n) $
           [ add ai $ mul (succ recipn) (sigs ! i)
           | (i, ai) <- zip [1 .. n] as ] ++ [0]

美しくない。

結果

計算の手順を明示化してリストで計算する。

abc326e n as = ans
  where
    recipn = modRecip n
    ans = reg $ recipn * foldr step 0 as
    step ai acc = reg $ ai + succ recipn * acc

modBase = 998244353 :: Int
reg x = mod x modBase
-- add x y = reg $ x + y
-- mul x y = reg $ x * y

modRecip a = fst $ loop a modBase
  where
    loop a 0 = (1, 0)
    loop a b = let (y, x) = loop b (mod a b)
               in  (x, y - div a b * x)

F - Robot Rotation

問題 ABC326F

シグネチャを決める。
結果は、そのまま出力する文字列とする。

abc326f :: Int    -- N
        -> Int    -- X
        -> Int    -- Y
        -> [Int]  -- Ai
        -> String -- 答え

考える

公式解説の方法$O(N 2^{N/4})$とユーザ解説 by maspy$O(2^{N/4})$は基本的な方針は同じである。

全体の流れは:

  1. X軸(東西)方向とY軸(南北)方向について独立して、それぞれの歩行距離$A_i$を正方向に使うか負方向に使うかを選択し、合計を目標値にできるならば、移動できるといえる。
  2. 目標値が作れることを確認するだけでなく、目標値を作るには、それぞれの値をプラスマイナスのどちらかに使うかという、目標値の作り方を一つ取り出す。
  3. さらに、東向きから開始し、現在の向きに応じて、それぞれの値をプラスマイナスに使うために向く方向を構成する。

1において、$N \leq 80$ ということは、座標軸ごとに独立で考えて40要素になり、$2^{40}$通りの座標を扱うことになり、無理がある。そこで、半分全列挙を使って、前半と後半の組み合わせで作れる数を全て見つけ出し、前半のそれぞれの値に対して、後半の値で、それと足すと目標値になるような値が見つかればよい、とすることができる。

まず、Y軸方向に使う値とX軸方向に使う値とに分離する。

abc326f n x y as = ...
  where
    dxs = [ai | (ai,True) <- zip as $ cycle [False,True]]
    dys = [ai | (ai,True) <- zip as $ cycle [True,False]]

半分全列挙のために、前半と後半に分割する。
極端に小さくなる場合は、無理に半分全列挙にはしないようにクランプしてみる。

    n4 = max 10 $ div n 4
    (dxs1, dxs2) = splitAt n4 dxs
    (dys1, dys2) = splitAt n4 dys

分割された $A_i$ の列それぞれについて、要素をプラスまたはマイナスした結果作れる値の集合を作る。
このとき、その作り方を復元できるような情報をオマケに付けておく必要がある。
オマケを、プラスで使ったときTrueとする[Bool]でするとして、IntMapで作ると次のようになる。

    [xm1,xm2,ym1,ym2] = map mkSeq [dxs1,dxs2,dys1,dys2]

mkSeq :: [Int] -> IM.IntMap [Bool]
mkSeq = foldl' step (IM.singleton 0 [])
  where
    step im ai = IM.union imp imm
      where
        imp = IM.map (True :) $ IM.mapKeysMonotonic (ai +) im
        imm = IM.map (False:) $ IM.mapKeysMonotonic (subtract ai) im

しかしこれはTLEした。
値をマイナスで使った場合のために(subtract ai) でキーを変えたIntMapを作る代わりに、目標値を $A_i$ の総和だけずらしておき、マイナスで使った場合はそのまま、プラスで使った場合は元の値の倍動かすことにする。
さらに、プラスで使った場合に、その値そのものをリストにメモする。このリストになければマイナスで使ったことになる。
これで、マイナス側を一切いじらずに済むようになった。

mkSeq :: [Int] -> IM.IntMap [Int]
mkSeq = foldl' step (IM.singleton 0 [])
  where
    step im ai = IM.union imp im
      where
        imp = IM.map (ai :) $ IM.mapKeysMonotonic ((ai + ai) +) im

こうしてできた二つのIntMapについて、二つのキーを足し合わせて目標値になるような組み合わせがあるかを探す。見つかったものについて、使う値のメモを正しい順に直して返す。一つも見つからなかった場合はこれが空リストになる。

    xans = findAns (x + sum dxs) xm1 xm2
    yans = findAns (y + sum dys) ym1 ym2

findAns :: Int -> IM.IntMap [Int] -> IM.IntMap [Int] -> [[Int]]
findAns x xm1 xm2 =
  [ reverse s1 ++ reverse s2 ++ [10^10]  -- 番兵つき
  | (x1,s1) <- IM.assocs xm1
  , Just s2 <- [IM.lookup (x - x1) xm2]]

xm1, xm2 の要素数はどちらも $M = 2^{N/4}$ で、二分探索を$M$回行うため $O(M \log M) = O(N 2^{N/4})$ となる。

最後に、xans, yans がいずれも空リストでないとき、先頭要素を使って、出力 [LR]+ を構成する。

abc326f n x y as =
  case (xans, yans) of
    (xans1:_, yans1:_) -> "Yes\n" ++ goEW True yans1 xans1 as
    _ -> "No"

goEW, goNS :: Bool -> [Int] -> [Int] -> [Int] -> String
goEW ew yys@(y:ys) xs (a:as)
  | y == a = (if ew then 'L' else 'R') : goNS True  xs ys  as
  | True   = (if ew then 'R' else 'L') : goNS False xs yys as
goEW _ _ _ [] = []
goNS ns xxs@(x:xs) ys (a:as)
  | x == a = (if ns then 'R' else 'L') : goEW True  ys xs  as
  | True   = (if ns then 'L' else 'R') : goEW False ys xxs as
goNS _ _ _ [] = []

まとめたものはこちら。2,783ms 457MB
ここまでが公式解説のアプローチに対応する。

さて、上の findAns において、xm1 の要素それぞれについて xm2 を素直に二分探索した。
しかし、もしこれが IntMap でなく、整列されていたならば、尺取法のようにしてより高速に目的のものを検索できる。

つまり、xm1の要素は小さい方から順に考え、xm2の要素は大きい方から順に考える。
両者を足し合わせた結果と目標値を比較して、

  • 小さいとき:より大きくするため、xm1の方を次に大きいものにずらす。
  • 大きいとき:より小さくするため、xm2の方を次に小さいものにずらす。
  • 等しいとき:見つかった。

この検索に掛かる計算量は、要素を全て消費するステップ数は要素数で$O(M) = O(2^{N/4})$ となる。
上の $O(N 2^{N/4})$ より、$N$がかからないだけずっと速い。

整列は sort で行う必要はない。
mkSeq において、キーに $A_i$ を足しても引いても、キーの順序は保たれる。
整列済みの列を合流させるには merge をするとリストの長さ $L$ について $O(L)$ で行える。

mkSeq の出力を IntMap [Int] から、キーの整列された対応付けリスト [(Int,[Int])] に変更する。
なお、「xm2を大きい方から小さい方に調べる」を reverse で実現すると、長さ $O(2^{N/4})$ のリストを反転することになって台無しなので、初めから降順で構築する。

    [xm1,ym1] = map (mkSeq (     compare `on` fst)) [dxs1, dys1]
    [xm2,ym2] = map (mkSeq (flip compare `on` fst)) [dxs2, dys2]

mkSeq :: ((Int,[Int]) -> (Int,[Int]) -> Ordering) -> [Int] -> [(Int,[Int])]
mkSeq c = foldl step [(0,[])]
  where
    step xass ai = mergeBy c imm imp
      where
        imp = [(x + ai, ai:as) | (x,as) <- xass]
        imm = [(x - ai,    as) | (x,as) <- xass]

mergeBy :: (a -> a -> Ordering) -> [a] -> [a] -> [a]
mergeBy c = loop
  where
    loop xxs@(x:xs) yys@(y:ys) =
      case c x y of
        LT -> x : loop xs yys
        EQ -> x : loop xs  ys
        GT -> y : loop xxs ys
    loop xs [] = xs
    loop [] ys = ys

都合の良い向きで二つの対応付けリストが得られたので、尺取法で目標値を探す。
一つ見つかったら止まる形にした。

abc326f n x y as =
  case (xans, yans) of
    (Just xans1, Just yans1) -> "Yes\n" ++ goEW True yans1 xans1 as
    _ -> "No"

findAns :: Int -> [(Int,[Int])] -> [(Int,[Int])] -> Maybe [Int]
findAns v xm1 xm2 = loop (xm1 ++ [(tooBig,[])]) (xm2 ++ [(- tooBig,[])])
  where
    loop xxs@((x,xl):xs) yys@((y,yl):ys) =
      case compare (x + y) v of
        _ | x == tooBig || y == - tooBig -> Nothing
        EQ -> Just $ reverse xl ++ reverse yl ++ [-1]
        LT -> loop xs yys
        GT -> loop xxs ys

まとめたものはこちら。784ms 123MB
これがユーザ解説 by maspyの内容に対応する。

別に特別に難しいアルゴリズムを使う訳でもなく、ほんの少しの気づきでこれだけ差が出てしまうとか恐ろしい。

G - Unlock Achievement

グラフの構造を工夫することで「最小カット問題」に落とし込むことができて、それは最大フロー問題と等価なのでそのアルゴリズムを適用すると答えが算出できる、という流れは理解できたが、問題の制約をグラフの構造に組み立てるやり方が理解できない。

2
0
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
2
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?