1
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?

@gotoki_no_joe(じょお)

ABC473をHaskellで

1
Posted at

たまには最新回も。

A - Second Half Sum

問題 ABC473A

シグネチャを決める。

abc473a :: Int   -- N
        -> [Int] -- Ai
        -> Int   -- 答え
abc473a n = sum . drop (div n 2)

B - Old Maid

問題 ABC473B

シグネチャを決める。

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

$A_i \in [1, 100]$ なので、この範囲のフラグ配列を用意し、その数のカードが奇数枚なら True になるように数える。
奇数枚なものの和が答え。

結果

import Data.Array

abc473b :: Int -> [Int] -> Int
abc473b _ as = sum [a | (a,True) <- assocs arr]
  where
    arr = accumArray (/=) False (1,100) [(a, True) | a <- as]

C - Change Schools

問題 ABC473C

喜ぶ…クラス…組…喜び…組…

シグネチャを決める。

abc473c :: Int   -- N
        -> Int   -- K
        -> [Int] -- Ai
        -> Int   -- 答え

B問題と同様に、各クラスの人数を数える。
クラスの人数の最大値を $X$ とする。
そのようなクラスに高橋君が加わると、そのクラスだけ $X+1$ 人で最多になるので喜ぶ。
人数が $X-1$ 人のクラスに加わると、そのクラスも $X$ 人になり最多クラスの仲間入りをし、「より多いクラスはない」ので喜ぶ。
結局、人数が $X-1$ 人以上のクラスの個数が答え。

結果

import Data.Array

abc473c :: Int -> Int -> [Int] -> Int
abc473c _ k as = length $ filter (pred ub <=) $ elems arr
  where
    arr = accumArray (+) 0 (1,k) [(a,1) | a <- as]
    ub = maximum $ elems arr

D - Coefficient Stair

問題 ABC473D

シグネチャを決める。

abc473d :: Int     -- N
        -> Int     -- K
        -> [[Int]] -- 答え

表示できるくらいなのだから、DPしたりせずに再帰関数で都度生成しても間に合う位の出力量なのだろうとタカをくくって、
go u v で u 以降の重みについて値 v を作る列を返す関数を作る。
u が N のときは、v が N で割り切れるならその商、さもなくば失敗。
u が N 未満のときは、uの個数を 0, 1, … と v を超えない範囲で順に増やして、u+1 について再帰呼び出しで作った結果と連結する。

結果

abc473d n k = go 1 k
  where
    go u v | u == n = [[q] | let (q,r) = divMod v n, r == 0]
    go u v = [x:ys | x <- [0 .. div v u], ys <- go (succ u) (v - u * x)]

ユーザ解説

「重みNから順に生成すれば最後は重み1で必ず生成できる、最後にソートすればへーきへーき」本当？
本当でした。

E - K-Divisible Subarrays

問題 ABC473E

シグネチャを決める。

abc473e :: Int   -- N
        -> Int   -- K
        -> [Int] -- Ai
        -> Int   -- 答え

考える

左端から各文字までのprefixに関する最大スコアを求めて、これを伸ばしていくDPを考える。
長さ0の列はスコア0である。
長さkの列のスコアは、$A_k$ は「和が倍数になる列」に使わないとき、長さ$k-1$のスコアに等しい。これが下限を与える。
$A_j, A_{j+1}, \dots, A_k$ の和が $K$ の倍数になるような区間がいくつかあるとき、
最も手前の（最も大きい添字 $j$ の）スコアを選び、それ＋１がスコアの候補になる。
このとき、貪欲に、なるべく短く区間を選べば、スコアが長さに対して単調増加するのでそれでよいとわかる。

手前の添字 $j$ を探すには、$A_k$ の累積和を $\bmod K$ で考えて、それが同じ値になるような最大の添字が $j$ となるとわかる。
なので、DPでは二つの配列を状態として持ち回す。

  • 各prefixの長さ 0～k に対する最大スコア $S[k]$
  • 各prefixの$A_i$の和 $\bmod K$の値をキーに、最大の添字を値にもつ $J[k]$

kを1増やして次の状態を作るには、次の操作をする

  • $S[k]$ の候補のひとつは $S[k-1]$
  • $J[\sum A_i \bmod K] = j$ となる $j$ があるとき、もう一つの候補は $S[j] + 1$
  • $S[k] = \max(S[k-1], S[j]+1)$ を追加する
  • $J[\sum A_i \bmod K] = k$ と上書き更新する

最終的に $S[N]$ が答えとなる。

なお、$K \leq 10^9$ と大きいので、$J[k]$ は配列として確保できないので IntMap などで扱う。
要素の個数は $N$ 個なのでメモリ消費もこのオーダーで収まる。

改善する

上の $S[k]$ は、末尾の値を追加する形でしか変更されない。
参照は $J[] = j$ となる $j$ の位置について起きるが、この値は $j$ について設定したときに確定し、その後は変化しない。
直前の結果を $S[k-1]$ としていちいち取り出しているのもかっこわるい。

これらの点は、次のようにして改善できる：

  • 毎回のステップの結果 $S[k]$ を、foldl の状態の一つとして取り回す
  • $J[]$ を引いてから値があったら $S[]$ を引く代わりに、その内容を直接持つ $JS[]$ という配列（マップ）一つにする

最終結果は、foldl の吐き出す、最終ステップの結果となる。

結果

import Data.List
import qualified Data.IntMap as IM

abc473e :: Int -> Int -> [Int] -> Int
abc473e _ k as = snd $ foldl' step (IM.empty, 0) $ scanl add 0 as
  where
    add x y = let z = x + y in if z >= k then z - k else z

    step (jsm, sj1) acj = (IM.insert acj sj jsm, sj)
      where
        sj = maybe sj1 (max sj1 . succ) (IM.lookup acj jsm)

F - A/AB Insertion

問題 ABC473F

シグネチャを決める。クエリが数リストで表せないのが泣ける。
セグメント木を使うのでmutableな計算が必須で、クエリにより答えを出したり出さなかったりするのが邪魔なので、タイプ2クエリの処理の中で出力も済ませてしまう形式にする。

import qualified Data.ByteString.Char8 as BS

type Query = Either (Int, Char) (Int, Int) -- タイプ1, タイプ2

abc473f :: Int           -- N
        -> BS.ByteString -- S
        -> Int           -- Q
        -> [Query]       -- Query_i
        -> IO ()         -- 答えは IO で出力

文字列を作る操作をじっと睨むと、「文字 B の左に、同じ個数以上の A が必要」が必要十分条件とわかる。
Aを開き括弧、B を閉じ括弧と読み替えると、括弧が閉じているのはいいが、閉じすぎているのはダメということ。

Advent of Code の最初の問題もそんな感じだったと思いつつ、この条件をさらに読み替えると、
A を＋１ B を－１として、前からの累積和が常に０以上であればよい。

という条件をいろいろな区間について調べたり、要素を差し替えたりするので、セグメント木が使えそう。
値を「（区間の総和，左端を除く区間のprefix和の最小値）」という整数対にする。
演算は op (a,b) (c,d) = (a+c, min b $ a + d) 単位元は (0, 適当に大きな値) とすればよい。

結果

import Data.Array.IO

abc473f :: Int -> BS.ByteString -> Int -> [Query] -> IO ()
abc473f n s _ qus =
  do
    st <- makeSegTree op e (map f $ BS.unpack s) :: IO (SegTree IOArray (Int,Int))
    mapM_ (action st) qus
  where
    op (a,b) (c,d) = (a + c, min b $ a + d)
    e = (0, n * 10)
    f 'A' = (1,1)
    f 'B' = (-1,-1)

    action st (Left  (i, c)) = writeSegTree st (pred i) $ f c
    action st (Right (l, r)) = do
      (_,b) <- querySegTree st (pred l) r -- 0-indexed
      putStrLn $ bool "No" "Yes" $ b >= 0

ユーザ解説が言っていることの実装がこれで、
このような値をセグメント木に入れるのは、
公式解説がやっている遅延セグメント木を使う解法を
遅延しないセグメント木で模倣するときのテクニックだった。そういえば。

G - Wipeout

問題 ABC473G

そんな名前のレースゲームがPlayStationにあった遠い記憶。

シグネチャを決める。

abc473g :: Int   -- N
        -> Int   -- K
        -> Int   -- 答え

考える

外したカードは確実に覚えておけるから、次に必要になるまで決してめくる必要はない。
戦略「まず、全てのカードを一度開く。その後正しい順に開く」では、
最後に1のカードを開くという運の悪さがあって回数$2N-1$、
偶然1から順にカードを開くという運の良さがあって回数$N$（これは全ての下限）
が、回数の下限と上限になる。

おそらく最善の戦略

  • 次のカードが既知なら、それを選ぶ。これは一度だけ開いたことがあるので、結局2回開いた。
  • そうでなければ、未知のカードを選ぶ。
    • 運良く正解を引いたら、ラッキー。1回開いて終わり。
    • 不正解なら、既知のカードが一枚増えた。

での状態推移を考える。
状態の要素は

  • 既に確定した手数（実行済みのものも含む）
  • まだ数が未知のカードの枚数
  • このような状態になる確率

の3項組 $(cnt, b, p)$ とする。
次に選んだカードが正解となる確率は $1/b$ で、状態は $(cnt+1, b-1, p/b)$ となる
不正解のなる確率は $(b-1)/b$ で、状態は $(cnt+2, b-1, p \cdot (b-1)/b)$ となる

$cnt$ ごとに別の IntMap にまとめ、
$b$ が同じ状態の確率は全て足し合わせて一つにまとめて扱う。
$cnt$からは$cnt+1$と$cnt+2$の状態に影響が及ぶので、3つの IntMap だけを触っていく。

最後に状態 $(K, 0, p)$ が持つ確率 $p$ が答え。

以上をコードにするとこうなる。

import qualified Data.IntMap as IM

abc473g :: Int -> Int -> Int
abc473g n k
  | n + n <= k = 0
  | otherwise  = go k (IM.singleton n 1) IM.empty
  where
    go 0   im _   = IM.findWithDefault 0 0 im
    go cnt im im1 = go (pred cnt) im11 im2
      where
        im11 = IM.unionWith add im1 $
               IM.fromListWith add [(pred b, mul p $ modRecip b) | (b, p) <- IM.assocs im, b > 0]
        im2  = IM.fromListWith add [(pred b, prodd [p, pred b, modRecip b]) | (b, p) <- IM.assocs im, b > 1]

小さい問題に対しては正しい結果が得られる。
$b$の変域は$N,K,cnt$からわかるので、これを制御して UArray を使うなど工夫しても、
そもそもの計算量が $O(NK)$ で全然間に合わない。

多項式の積

公式解説を見た。convolution を使って多項式の係数として答えを取り出す、と。

要約すると、
$\frac{1}{N!} \prod_{k=1}^N ((k-1)x + 1)$ の $x^{M-N}$ の係数が答えなので、
まずはN個の一次式の総積をconvolutionで求める。
長さが近いものどうしを掛け合わせるために、キューにいれてロケット鉛筆するといい。
ということらしい。

convolutionにはポンコツな自前のものを使って、コードにしてみる。
Data.Sequnce もポンコツなんだが。

import Data.Array.Unboxed
import qualified Data.Sequence as Q

abc473g :: Int -> Int -> Int
abc473g n k
  | n + n <= k = 0
  | otherwise  = prodd $ arr ! (k - n) : map modRecip [1 .. n]
  where
    arr Q.:<| _ = until ((1 ==) . Q.length) step $ Q.fromList [listArray (0,1) [1, pred k] | k <- [1 .. n]]
    step :: Q.Seq (UArray Int Int) -> Q.Seq (UArray Int Int)
    step (a1 Q.:<| a2 Q.:<| q) = q Q.|> (convolution (elems a1) (elems a2))

convolution :: [Int] -> [Int] -> UArray Int Int

愚直解が TLEx12 このconvolution解が TLEx10 あまり変わっていない。
AtCoderライブラリを使ってgksato=サンがACしているので、やればやれるのだろう。

1
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
Sign upLogin
1
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?