LoginSignup
1
0
@gotoki_no_joe(じょお)

ABC323 A～F をHaskellで

Last updated at Posted at 2023-10-11
  • E : 配るDP

A - Weak Beats

問題 ABC323A

シグネチャを決める。

abc323a :: String -- S
        -> Bool   -- 答え
abc323a (_:'0':s) = abc323a s
abc323a ""        = True
abc323a _         = False

B - Round-Robin Tournament

問題 ABC323B

シグネチャを決める。

abc323b :: Int      -- N
        -> [String] -- Si
        -> [Int]    -- 答え

各プレイヤーの勝利回数を数え、その降順、ただし同順の場合は番号の昇順、という順序でソートし、番号を抜き出す。
そのような比較関数を作って sortBy するのが王道だが、符号を反転させるのが手っ取り早い。

結果

import Data.List

abc323b :: Int -> [String] -> [Int]
abc323b _n ss = map snd $ sort [(- c, i) | (s,i) <- zip ss [1..], let c = length $ filter ('o'==) s]

バケツソートによる方法

ユーザ解説 by shobonvipに、oの個数でバケツソートすれば $O(N)$でできるという指摘があったのでやっておく。

import Data.Array

abc323b :: Int -> [String] -> [Int]
abc323b n ss =
    concatMap reverse $ elems $
    accumArray (flip (:)) [] (0,n) $
    [(length $ filter ('o' /=) s, i) | (s,i) <- zip ss [1..]]

この問題は$N$が小さいのでそこまで考えなくてもできてしまうが、確かに、バケツソートで済む場面を見落とさないようにすることも大事だ。

C - World Tour Finals

問題 ABC323C

シグネチャを決める。

abc323c :: Int      -- N
        -> Int      -- M
        -> [Int]    -- Ai
        -> [String] -- Si
        -> [Int]    -- 答え

各プレイヤーの現在の得点を数える。
最高得点とそれを持つ人を探す。

あとは、一般論では、それぞれのプレイヤーごとに、解いていない問題の配点を大きい順に貪欲に解き、合計点が現状の最高得点を上回る回答数を調べればよい。
ただしここで、最高得点を取っているのが一人だけの場合、その人は追加の必要がないことに注意が必要である。
最高得点の同着が複数人いる場合は、最高得点者についても同じ手続きでよい。と細かい場合分けが必要。

ところでこの問題では配点が100点刻みでプレイヤー数の上限が100人なので、ボーナス点を考えると点数が被ることはなく、同着は発生しない。
そこで、最高得点以上になるまでの回答数を考えるだけで、最高得点者本人もそれ以外も全て正しい結果が得られる。

結果

import Data.List

abc323c :: Int -> Int -> [Int] -> [String] -> [Int]
abc323c _n _m as ss = zipWith f scores ss
  where
    scores = [i + sum [a | (a, 'o') <- zip as s] | (s, i) <- zip ss [1..]]
    scoremax = maximum scores
    f score s = length $ takeWhile (scoremax >) $ scanl (+) score $ sortBy (flip compare) [a | (a, 'x') <- zip as s]

AtCoder構文

プレイヤーiがまだ解いていない問題を少なくとも何問解くことで、プレイヤーiの総合得点が他のプレイヤー全員の現在の総合得点を上回ることができますか︖

目標を先に設定してくれた方が、そのための行動の意味が理解しやすいかなぁ？ということで例えば：

プレイヤーiの総合得点が、他のどのプレイヤーの現在の総合得点も上回るようにするために必要な、プレイヤーiがさらに解くべき問題数は最小でいくつですか？

D - Merge Slimes

問題 ABC323D

シグネチャを決める。

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

貪欲に、小さい方のスライムから考えて、可能な限り合成する。奇数なら一匹余り、これはもうどうにもならない。
合成で出現したスライムは、元からいた同じ大きさのスライムと合わせて、再度合成に回す、を繰り返す。

結果

import qualified Data.IntMap as IM

abc323d :: Int -> [(Int,Int)] -> Int
abc323d _n scs = length $ loop $ IM.fromList scs
  where
    loop im
      | IM.null im = []
      | c == 1     = 1 : loop im1
      | odd c      = 1 : loop im2
      | otherwise  = loop im2
      where
        ((s, c), im1) = IM.deleteFindMin im
        im2 = IM.insertWith (+) (s + s) (div c 2) im1

解説を読む

上のやり方は、公式解説の補足と同じアイデア、つまり想定解ではないらしい。えっ？

想定解はいきなりややこしいことを言い出しているが、popcount を使う方法 by Kiri8128とあわせて読み解く。
スライムのサイズが奇数 $d$ を用いて $d \times 2^k$ と表せるようなもの同士は合成で合流しうるが、そうでないものは交わらないので、この $d$ を「タイプ」として分類する。
タイプ$d$サイズ$d \times 2^k$のスライム$2C$匹を全て合成すると、同じタイプ$d$倍サイズ$d \times 2^{k+1}$が$C$匹になる。奇数のときに1匹残して残りはさらに合成する、を、合流したサイズのものも含めて繰り返す様子を考えると、スライムの総重量は合成に関して不変であり、総重量を$d$で割った値（スコア）を2進数で表したときの1のビットが、可能な限り合成を行ったとき、奇数になって最後まで残るスライムに対応する。

結局、スライムのサイズからタイプを算出し、タイプごとにスコアを集計して、その1のビットの個数の総和が答えになる。

import qualified Data.IntMap as IM
import Data.Bits

abc323d :: Int -> [(Int,Int)] -> Int
abc323d _n scs =
    sum $ map popCount $ IM.elems $
    IM.fromListWith (+)
    [(div s powk, c * powk) | (s,c) <- scs, let powk = s .&. negate s]

E - Playlist

問題 ABC323E

シグネチャを決める。

abc323e :: Int    -- N
        -> Int    -- X
        -> [Int]  -- Ti
        -> Int    -- 答え

時刻0～$X$に関して、新たな曲を開始する瞬間になる確率を求める。
時刻0は1で、ある時刻から楽曲の長さ$T_i$過ぎた時刻はその$1/n$だけ確率を持つ。
時刻$(X-T_1+1)$～$X$から曲1を開始すると、時刻$X+0.5$では曲1が演奏中になるので、
それらの時刻での確率に$1/n$を掛けたものの和が求める確率である。

集めるDPによる解法

各時刻が曲の開始になる確率の上述の定義は配るDPと親和性が高いが、Haskellは集めるDPの方が得意なので、そのように言い直すと次のようになる。
ある時刻$T$の確率は、時刻$T - T_i$の確率に、曲$i$が選ばれる確率$1/n$を掛けたものの総和である。

\begin{array}{l}
P[0] = 1 \\
P[T] = \frac{1}{n} \sum_{i=1}^N P[T - T_i] \\
P[T<0] = 0
\end{array}

import Data.Array

abc323e :: Int -> Int -> [Int] -> Int
abc323e n x ts@(t1:_) = mul recipN $ reg $ summ $ drop (x - t1 + 1) $ elems pa
  where
    recipN = modRecip n -- 1/n のmodP
-- pa : 時刻0～Xが、新たな曲を選択して始めるタイミングになっている確率
    pa = listArray (0,x) $ map paf [0..x]
    paf 0 = 1
    paf t = mul recipN $ summ [pa ! t1 | t1 <- takeWhile (0 <=) $ map (t -) sts]
    sts = sort ts

add, mul, summ, modRecip は省略。
結果：111ms, 10MB

配るDPによる解法

配るDPは、確定した要素の内容を順に配っていく、という命令的な側面があるので、純粋関数型で綺麗に表現できない。
（自分ができていないだけかもしれないが。）

命令的な計算をSTモナドで隠して、配るDPを計算する汎用的な関数を作ってみる。
確定する順序は添え字の Data.Ix.range 順とする。

import Data.Array.ST
import Data.Array
import Control.Monad

distributingDP :: Ix i                 -- DP配列の添え字
               => (i,i)                -- DP配列の添え字の範囲
               -> x                    -- DP配列の初期値
               -> [(i,x)]              -- DP配列に初めから入る値
               -> (i -> x -> [(i,x)])  -- 配る関数
               -> (x -> x -> x)        -- 配られた値をくっつける関数
               -> Array i x            -- こたえ、DP配列
distributingDP bnds i inis df op = runSTArray $
  do
    arr <- newArray bnds i
    forM_ inis $ uncurry (writeArray arr)
    forM_ (range bnds) $ \i -> do
      x <- readArray arr i
      forM_ (df i x) $ \(j, y) -> do
        z <- readArray arr j
        writeArray arr j $! op y z
    return arr

これを使うと次のようになる。

abc323e :: Int -> Int -> [Int] -> Int
abc323e n x ts@(t1:_) = mul recipN $ reg $ summ $ drop (x - t1 + 1) $ elems pa
  where
    recipN = modRecip n -- 1/n のmodP
-- 時刻0～Xが、新たな曲を選択して始めるタイミングになっている確率
    pa = distributingDP (0,x) 0 [(0,1)] df add
    df t p = [(t1, q) | let q = mul p recipN, t1 <- takeWhile (x >=) $ map (t +) sts]
    sts = sort ts

結果：71ms, 11MB

F - Push and Carry

問題 ABC323E

倉庫番か。シグネチャを決める。手抜きする。

abc323f :: [Int]  -- XA,YA,XB,YB,XC,YC
        -> Int    -- 答え

なんか毛色の変わった問題だ。

考える

人には簡単に見えて、コード化しようとすると案外面倒くさい話で、荷物の裏側に回り込まないといけない場合の歩数、その条件を網羅するのが大変に見える。
状況を整理するために正規化することを考える。
まず、目標地点 $(X_C,Y_C)$ を任意の位置とする代わりに、原点になるように全体を平行移動させる。

abc323f [xa,ya,xb,yb,xc,yc] = step1 (xa - xc) (ya - yc) (xb - xc) (yb - yc)

次に、荷物の座標がいずれも正または0になるように、負のときは反転させる。

step1 xa ya xb yb
  | xb < 0    = step2 (- xa) ya (- xb) yb
  | otherwise = step2 xa ya xb yb

step2 xa ya xb yb
  | yb < 0    = step3 xa (- ya) xb (- yb)
  | otherwise = step3 xa ya xb yb

さらに、もし荷物がY軸上にあるなら、軸を交換して転置する。

step3 xa ya 0  yb = step4 ya xa yb 0
step3 xa ya xb yb = step4 xa ya xb yb

これで、荷物は必ず第１象限またはX軸上にある。

障害物を考えなければ、二つの地点の間を移動するステップ数はマンハッタン距離である。

dist x1 y1 x2 y2 = abs (x1 - x2) + abs (y1 - y2)

一般の場合は、まず荷物の上隣または右隣のマスに移動し、そこから荷物を原点まで押すことになる。
上隣に移動した場合はまず下にX軸まで押し、2歩で荷物の右隣に移動し、さらに原点まで押す。
右隣に移動した場合も同様になる。この二つの選択肢から、小さい方を選ぶ必要があることが例1からわかる。

step4 xa ya xb yb
  | otherwise = d1 + min dN dE + 2
  where
    d1 = dist xb yb 0 0           -- 荷物を押す距離
    dN = dist xa ya xb (succ yb)  -- 荷物の上隣までの距離
    dE = dist xa ya (succ xb) yb  -- 荷物の右隣までの距離

自分が荷物の真下方向あるいは真左方向にいるとき、荷物の上隣あるいは右隣に行くには回り込む必要がある。
そのような場合は、回り込まなくても行ける方を先に押す方が確実に早い。

step4 xa ya xb yb
  | beS = d1 + dE + 2
  | beW = d1 + dN + 2
  | otherwise ...
  where
    beS = xa == xb && ya < yb  -- 荷物の真南にいる
    beW = ya == yb && xa < xb  -- 荷物の真西にいる

さらに、荷物がX軸上にあるときは、上隣に移動して下に押す必要がそもそもない。
ここで、真左方向にいるときは回り込みが必要、そうでないときは不要、という場合分けが起きる。

step4 xa ya xb yb
  | yb == 0 = d1 + dE + if beW then 2 else 0
  | ...

これで場合を網羅できた。

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