1
1

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 1 year has passed since last update.

ABC315 A~G をHaskellで

Posted at

C,D,Fと、問題の性質を利用した解法が求められる問題が集中していた感。Gもそうなのかな?

A - tcdr

問題 ABC315A

シグネチャを決める。

abc315a :: String -> String
abc315a = filter (flip notElem "aeiou")

B - The Middle Day

問題 ABC315B

シグネチャを決める。

abc315b :: Int    -- M
        -> [Int]  -- Di
        -> (Int,Int)  -- 答え 月,日

月の日数を累積すると、それぞれの月の最終日が年の何日目かがわかる。
一年の真ん中の日$C$を最終日が超えない最大の月$L$とその最終日$D_L$を見つけたら、答えは$L+1$月の$C-D_L$日目である。

結果

abc315b m ds = (length ds1, theday - last ds1)
  where
    accs = scanl (+) 0 ds
    theday = div (succ $ last accs) 2
    ds1 = takeWhile (theday >) accs

C - Flavors

問題 ABC315C

シグネチャを決める。$F_i, S_i$は手抜きする。

abc315c :: Int      -- N
        -> [[Int]]  -- Fi, Si
        -> Int      -- 答え

それぞれの味のアイスクリームについて、おいしさが最高のものと次点のものだけを考慮すればよい。
ある味$F$のアイスのおいしさトップ2が$S_1 > S_2$で、その他の味のアイスのおいしさトップが$S_3$のとき、味を混ぜて $S_1 + S_3$ と同じ味 $S_1 + S_2/2$ が最良の選択の候補になる。

またその中でも、味を混ぜる場合は、それぞれの味のアイスの最高のおいしさのものを持ち寄った中のトップ2を使うのがベストである。
同じ味の場合は、トップの味の大小だけでは決まらず、次点のおいしさで逆転もありうるので、全て求めて最大値を探す。

結果

味で分類するために IntMap を使う。
違う味を混ぜることは味が全体で1種類しかないとできない、同じ味を2つ選ぶことは同じ味のアイスが2つは必要、という必要条件を確認する必要がある。

import qualified Data.IntMap as IM

abc315c :: Int -> [[Int]] -> Int
abc315c n fss = maximum $
  [ a + b |   let (a,b) =  cand1, b > 0 ] ++
  [ a + div b 2 | (a,b) <- top2s, b > 0 ]
  where
    top2s = map getTop2 $ IM.elems $ IM.fromListWith (++) [(f,[s]) | f:s:_ <- fss]
    cand1 = getTop2 $ map fst top2s

-- 最大と次点を取り出す
getTop2 :: [Int] -> (Int, Int)
getTop2 = foldl' top2 (-1,-2)
  where
    top2 (a,b) c
      | c > a = (c,a)
      | c > b = (a,c)
      | True  = (a,b)

getTop2 を何度も使えて面白い問題だ、と悦に入っていたのも束の間…

アライさんの解法

「C問題は、一番美味しいアイスクリームは必ず選んで、もう片方を全探索すればいいのだ!」

えっ何で?一番美味しいアイスと同じ味でおいしさが次点のものとの組み合わせより、違う味のトップ2の方が捲ることはないの?とたじろいでしまったので検証。

おいしさトップ$A_1$ 同じ味の次点のおいしさ$A_2$ ここで $A_1 \geq A_2$
おいしさ2着(同着含む)$B_1$ 同じ味の次点のおいしさ$B_2$ ここで $A_1 \geq B_1 \geq B_2$
としたとき、満足度の候補は
$X_1 = A_1 + B_1$
$X_2 = A_1 + A_2 / 2$
$X_3 = B_1 + B_2 / 2$
ぐらいあって、$A_1$を使わない$X_3$がこの中で最大になることがない、を確認したい。
$X_1 - X_3 = A_1 - B_2 / 2 \gt 0$ $(\because A_1 \geq B_2)$ つまり、$X_3$は$X_1$より小さい。
$X_1 > X_2$のとき、$X_1 \geq X_3$ が言えているので結局ベストは$X_1$
$X_1 < X_2$のとき、$X_1 \geq X_3$ が言えているので結局ベストは$X_2$
$X_1$と$X_2$のトップ争いに、$A_1$を使わない$X_3$は絡めない、とわかる。

なるほど…

import Data.List

abc315c :: Int -> [[Int]] -> Int
abc315c n fss = maximum
                [ s1 + if f1 == f then div s 2 else s
                | f:s:_ <- delete fs1 fss ]
  where
    fs1@(f1:s1:_) = maximumBy (\(_:a:_) (_:b:_) -> compare a b) fss

Data.List.deleteが、「指定されたものを一つ削除」だったり「指定されたものを全て削除」だったり、時期によって違うのが困る。

D - Magical Cookies

問題 ABC315D

シグネチャを決める。

abc315d :: Int       -- H
        -> Int       -- W
        -> [String]  -- cij
        -> Int       -- 答え

$c_{i,j}$をリストのリストで持っておき、条件を満たす行と列を取り除く、というナイーブな解法は全く間に合わない。

$C_{i,j}$を二次元配列に入れておき、取り除かれていない行の番号と列の番号をリストで持っておくと、添え字の読み替えをするだけでよくなったが、それでも間に合わない。あれっ?

ここでまたアライさんに助けを求めて

行・列にどの文字が何個あるかを持って、操作ごとに更新することにすれば、チェックが1回あたりO(26(H+W))になって間に合うのだ!

ある列が削除されるとき、その文字は全て同じだから、行に対して、何文字目が消えるとか気にせず、1つ消えるのはどの文字か、だけわかっていればいい、ということか!ズルい!

結果

要素数26の配列なら、更新が遅いのも気にならないだろうと immutable array で実装。

import Data.List
import Data.Array.Unboxed

abc315d :: Int -> Int -> [String] -> Int
abc315d _h w css = length hAsN * length vAsN
  where
-- カウント配列を作る
    cntArray = accumArray (+) 0 ('a','z') . map (\x -> (x,1))
-- 行ごとに文字の個数を数える
    hAs0, vAs0 :: [Array Char Int]
    hAs0 = [cntArray cs  | cs <- css]
-- 列ごとに文字の個数を数える
    vAs0 = [cntArray tcs | tcs <- transpose css]
-- 操作を可能な限り繰り返した結果
    (hAsN, vAsN) = loop hAs0 vAs0
-- 0個でない文字が1種類かつ2文字以上な行と列を抽出して、それと、逆側からと削除して、を繰り返す
    loop :: [Array Char Int] -> [Array Char Int] -> ([Array Char Int], [Array Char Int])
    loop hAs vAs
      | null hAsX, null vAsX = (hAs, vAs)
      | otherwise = loop hAs2 vAs2
      where
-- 削除する行/列、残す行/列
        (hAsX, hAs1) = partition prop hAs
        (vAsX, vAs1) = partition prop vAs
-- 残す行/列から減らす文字の種類とカウント
        vDels = [(c, 1) | hAx <- hAsX, (c,i) <- assocs hAx, i > 1]
        hDels = [(c, 1) | vAx <- vAsX, (c,i) <- assocs vAx, i > 1]
-- 残す行/列から除かれる列/行の文字を引く
        hAs2 = map (\hA1 -> accum (-) hA1 hDels) hAs1
        vAs2 = map (\vA1 -> accum (-) vA1 vDels) vAs1
-- 0でない要素が1つだけで、それが2以上か
    prop arr =
      case filter (0 <) $ elems arr of
        [x] -> x >= 2
        _   -> False

引き算をするところで、accum (-) をするべきなのを凡ミスで (//) にしてしまったが、それでも例1~3他、かなりのケースが通ってしまった。これを AtCoder Companions で探したら、C++の提出で、行について引く計算を列について引く計算からコピペして、添え字を縦横入れ替えるのを忘れた、と思われる差分が多数見つかった。原因は全然違っているのに、テストケースの結果は同じになることがあることにびっくり。

E - Prerequisites

問題 ABC315E

シグネチャを決める。$C_i, P_{i,j}$は手抜きする。

abc315e :: Int      -- N
        -> [[Int]]  -- Ci, Pij
        -> [Int]    -- 答え

本1と直接繋がっている本に関してのみ、トポロジカルソートをすればよい。

結果

リストを、未処理の本を積み上げるスタックとして、深さ優先探索をする。
依存関係が解消された本は番号を出力して終わる。

import Data.Array
import qualified Data.IntSet as IS

abc315e :: Int -> [[Int]] -> [Int]
abc315e n cpss = loop graph IS.empty (graph ! 1)
  where
    graph = listArray (1,n) $ map tail cpss

loop :: Array Int [Int]  -- グラフ
     -> IS.IntSet        -- 答えに既に入っている本の集合
     -> [Int]            -- 読むべき本のスタック
     -> [Int]            -- 答え
loop _ _ [] = []
loop graph dones vvs@(v:vs)
  | IS.member v dones = loop graph dones vs
  | null needs = v : loop graph (IS.insert v dones) vs
  | otherwise = loop graph dones (needs ++ vvs)
  where
    needs = filter (flip IS.notMember dones) (graph ! v)

needsの計算が、到着したときと抜けるときの2度行われるのが微妙な気もする。

F - Shortcuts

問題 ABC315F

シグネチャを決める。$X_i, Y_i$は手抜きする。

abc315f :: Int      -- N
        -> [[Int]]  -- Xi, Yi
        -> Double   -- 答え

ポイント$A$からポイント$B$の直線距離を $dist(A,B)$と表す。

ポイント$1$からポイント$I$まで、ポイントを$J$個飛ばして移動する最短距離を$cost[1 \leq I \leq N][0 \leq J \leq \max(0,I-2)]$に求めるDPを考える。
最終的な答えは $\displaystyle \min_{0 \leq C \leq N-2} (\lfloor 2^{C-1} \rfloor + cost[N][C])$ になる。

まず $cost[0] = \{0\}$ である。
$cost[I][J]$を求めるには、より手前の $1 \leq K < I$ については$cost[K][J]$は得られているとして、手前のポイント$K$まで$C_1$個飛ばして移動して、さらに$K$からは$I$に一気に$C_2 = I - K - 1$個飛ばして移動するときの移動距離は $cost[K][C_1] + dist(K,I)$ で、このとき飛ばす個数は $C_1 + C_2$ である。
これを$K,C_1$について総当たりすると、計算量が$O(N^3)$となり間に合わない。???

ここでまたまたアライさんに助けを求めて

「全部のチェックポイントを通っても距離は3×10^8くらいにしかならないから、ペナルティがそれより大きくなるケースを考えるのは無駄なのだ! ということは、無視するチェックポイントが30個以下くらいのときだけ考えればよくてO(30^2 N)になって解けるのだ!」

なにそれズルい…

最も遠い位置に二つのポイントを置くと $(0,0) - (10^4,10^4)$で距離は$\sqrt{2} \times 10^4$ これの $10^4 - 1$倍で、$2^{27} < 1.4 \times 10^8 < 2^{28}$ といったところなので、飛ばすポイントは0から29まで押さえればよいようだ。

結果

全体を遅延配列のDPで実装したらTLEした

UArrayを使うために、配列のリストが、第 $I$ 要素が $cost[I]$ を持つようにして、自身より手前の要素を使って次が求められる、という計算で表現した。

import Data.Array.Unboxed

abc315f :: Int -> [[Int]] -> Double
abc315f n xys = minimum $ zipWith (+) (elems (last costs)) (0 : iterate (2 *) 1)
  where
    xA, yA :: UArray Int Int
    xA = listArray (1,n) $ map head xys
    yA = listArray (1,n) $ map (!! 1) xys
-- ポイント間の直線距離
    dist :: Int -> Int -> Double
    dist a b = sqrt $ fromIntegral $ ((xA ! a) - (xA ! b)) ^ 2 + ((yA ! a) - (yA ! b)) ^ 2
-- cost配列のリスト
    costs :: [UArray Int Double]
    costs = cost1 : map costF [2..n]
    cost1 = listArray (0,0) [0]
-- X番目の配列の添え字の上限(飛ばせるポイント数)
    bndf x = min 29 $ max 0 $ x - 2
-- 1~i-1を使って cost !! i を作るaccumArray min
    costF i = accumArray min tooBig (0, ub)
      [ (c, dm + costm ! c1)
      | (m, costm) <- zip [1 .. pred i] costs
      , let c2 = i - m - 1, let dm = dist m i
      , c1 <- [0 .. bndf m]
      , let c = c1 + c2, c <= ub
      ]
      where
        ub = bndf i

tooBig :: Double
tooBig = 10^9

G - Ai + Bj + Ck = X (1 <= i, j, k <= N)

問題 ABC315F

シグネチャを決める。手抜きする。
なぜ Integer なのかも後回しで。

abc315g :: [Integer]  -- N,A,B,C,X
        -> Int        -- 答え

まるで訳わからなかったので、解説に頼る。

写経、あるいは解釈と翻訳

まず、$i$ について$1$から$N$について全て考えて、つまり $Bj + Ck = X - Ai$ を満たす$(j,k)$の個数をそれぞれ導いて、その総和をとる。$X - Ai = Y$ とでも置いておく。

abc315g [n,a,b,c,x] = sum
    [ ...
    | y <- ys
    , ...
    ]
  where
    ys = take (fromIntegral n) $ iterate (subtract a) (x - a)

その個々の問題として $Bj + Ck = Y$ (式1とする)を満たす $(j,k)$ を見つけるには、まず拡張ユークリッドの互除法を用いて $Bj + Ck = \gcd(B,C)$ の一つの解 $(j_0, k_0)$ (および$\gcd(B,C)$、これを$G$とする)を得る。

  where
    ...
    ((j0,k0),g) = extendGCD b c

extendGCD :: Integral b => b -> b -> ((b, b), b)
extendGCD a b = loop a b
  where
    loop a 0 = ((1, 0), a)
    loop a b = let ((y, x), d) = loop b (mod a b)
               in  ((x, y - (div a b) * x), d)

そして、$Y$が$G$の倍数であることが、式1に整数解がある必要条件なので、そうでなければこの$i$については解は0個となる。(ナンデ?)

    [ ...
    | y <- ys
    , let (y1, r) = divMod y g, r == 0
    , ...

他に、$i = 1,2,\dots,N$ の順で調べるとき、$Y$は$A$ずつ小さくなるが、$1 \leq j,k \leq N$から、$B + C \leq Y$ という下限で $i$ の走査を打ち切ることができ、$Y \leq N(B+C)$ という上限までは $i$ の走査の初期部分を飛ばすこともできる。

  where
    ys = takeWhile (b + c <=) $ dropWhile (n * (b + c) <) $
         take (fromIntegral n) $ iterate (subtract a) (x - a)
    ...

話を戻して、$Y$が$G$の倍数であるとき$Y = yG, B = bG, C = cG$ とおいて、式1を $bGj + cGk = yG$, $bj + ck = y$ (式2とする)と変形する。拡張ユークリッドの互除法で得られた解は $bGj_0 + cGk_0 = G$, $bj_0 + ck_0 = 1$(式3とする)となる。

  where
    ...
    b1 = div b g
    c1 = div c g

式3を$y$倍すると式2になるので、$(y j_0,y k_0)$は式2の一つの解である。
また、これに$(c,-b)$を任意回($t$とする、負も許す)足した$(yj_0 + ct, yk_0 - bt)$も式2の解になる。
(実際、この一般解を式2の左辺に代入すると $b(yj_0 + ct) + c(yk_0 - bt) = byj_0 + cyk_0 + bct - cbt$ と、$t$の項は打ち消される。)
そして解はこれしかない。(ナンデ?)

解の範囲 $1 \leq j,k \leq N$ に一般解を代入して、$t$の範囲の式にすると、$b,c$を正と仮定して

\frac{1 - y j_0}{c} \leq t \leq \frac{N - y j_0}{c}
\frac{y k_0 - N}{b} \leq t \leq \frac{y k_0 - 1}{b}

となる。$b,c$が負の場合は不等号の向きが逆になる。これらを Rational で求めて、小さい方を下限、大きい方を上限とする。

    [ ...
    | ...
    , let (lb1, ub1) = minMax ((1 - y1 * j0) % c1) ((n - y1 * j0) % c1)
    , let (lb2, ub2) = minMax ((y1 * k0 - n) % b1) ((y1 * k0 - 1) % b1)
    ]

minMax :: Ord b => b -> b -> (b, b)
minMax x y
  | x <= y = (x, y)
  | True   = (y, x)

$t$の範囲の共通部分に含まれる整数の個数がこの周回の答えとなる。

    [ max 0 $ floor (min ub1 ub2) - ceiling (max lb1 lb2) + 1
    | y <- ys
    , ...

結果

上のコード断片を統合する。結果は1031ms, 11MB

import Data.Ratio

abc315g :: [Integer] -> Int
abc315g [n,a,b,c,x] = sum
    [ max 0 $ floor (min ub1 ub2) - ceiling (max lb1 lb2) + 1
    | y <- ys
    , let (y1, r) = divMod y g, r == 0
    , let (lb1, ub1) = minMax ((1 - y1 * j0) % c1) ((n - y1 * j0) % c1)
    , let (lb2, ub2) = minMax ((y1 * k0 - n) % b1) ((y1 * k0 - 1) % b1)
    ]
  where
    ys = takeWhile (b + c <=) $ dropWhile (n * (b + c) <) $
         take (fromIntegral n) $ iterate (subtract a) (x - a)
    ((j0,k0),g) = extendGCD b c
    b1 = div b g
    c1 = div c g

extendGCD :: Integral b => b -> b -> ((b, b), b)
extendGCD a b = loop a b
  where
    loop a 0 = ((1, 0), a)
    loop a b = let ((y, x), d) = loop b (mod a b)
               in  ((x, y - (div a b) * x), d)

minMax :: Ord b => b -> b -> (b, b)
minMax x y
  | x <= y = (x, y)
  | True   = (y, x)

たねあかし

最初は Ratio Int でやっていたが、Int の桁あふれが原因のWAがあったので、lb1,ub1,lb2,ub2Rational にしたら一つ直った。(そしてなぜか速くなった。)それでもまだ残ったWAは、全体を Integer にしたら直った。

これが、公式解説において

ここで、この時の各変数の値を long long に収めながら処理できることに注意してください。

と忠告されている壁で、注意深くしないと収まらない、ということだろう。
ここでは注意深くする代わりに、IntegerRational でごり押しした。

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

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?