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?

More than 1 year has passed since last update.

ABC310 A~F をHaskellで

Posted at

A - Order Something Else

問題 ABC310A

シグネチャを決める。

abc310a :: Int   -- N
        -> Int   -- P
        -> Int   -- Q
        -> [Int] -- Di
        -> Int   -- 答え

結果

問題の設定通り、全ての買い方の金額を作り、最安値を探すやり方

abc310a _n p q ds = minimum (p : map (q +) ds)

最も安い料理と合わせた場合とドリンク単品の値段だけを比較するやり方

abc310a _n p q ds = min p (q + minimum ds)

B - Strictly Superior

問題 ABC310B

シグネチャを決める。$P_i,C_i,F_{i,j}$は無精する。

abc310b :: Int   -- N
        -> Int   -- M
        -> [[Int]] -- Pi, Ci, Fij
        -> Bool  -- 答え

$F_{i,j}$ は IntSet で管理すれば、抽象的な表現のまま計算できる。
同じものどうしを試してもこの条件なら誤認識はないので、手抜きして $N \times N$ の全てを試してもよいが、調べるべき向きは価格から定まるので、そこまではしない。

結果

import qualified Data.IntSet as IS
import Data.List

abc310b :: Int -> Int -> [[Int]] -> Bool
abc310b _n _m pcfss = not $ null
    [ () | pF:qGs <- tails pFs, qG <- qGs, prop pF qG]
  where
    pFs = [(p, IS.fromAscList fs) | p:_c:fs <- pcfss]

prop (p,f) (q,g) =
  case compare p q of
    LT -> IS.isSubsetOf g f
    GT -> IS.isSubsetOf f g
    EQ -> IS.isProperSubsetOf f g || IS.isProperSubsetOf g f

Fの集合を64ビット整数2ワードのビット列で表現するとか、そういう最適化はこれが動いてから。(自戒)

C - Reversible

問題 ABC310C

シグネチャを決める。データ量が多そうなのでByteStringを用いる。

import qualified Data.ByteString.Char8 as BS

abc310c :: Int              -- N
        -> [BS.ByteString]  -- Si
        -> Int              -- 答え

そのままの文字列と逆順にした文字列との小さい方で正規化し、異なるものの個数を数えればよい。

結果

abc310c :: Int -> [BS.ByteString] -> Int
abc310c n ss = length $ group $ sort [min s $ BS.reverse s | s <- ss]

もちろん Data.Setで数えるのでもよい。

D - Peaceful Teams

問題 ABC310D

シグネチャを決める。

abc310d :: Int          -- N
        -> Int          -- T
        -> Int          -- M
        -> [(Int,Int)]  -- Ai,Bi
        -> Int          -- 答え

$N \leq 10$ と小さいので実際に数え上げる。
番号の小さい方の人から順に考えて、既に割り当てられたチームの個数とそれぞれのメンバーの番号を追跡する。
最初はチーム数が0。
次の人を考えるとき、既存のチームで所属できるものに所属するか、もう一つ別のチームを作ってそこの最初のメンバーにする(チーム数がT未満のとき)。
最後のメンバーまで割り当てたとき、チーム数がTに届いている場合を数え上げる。

$N \leq 10$ と小さいので、各チームの情報も(本来はimmutableな)Data.Arrayで扱う。割り当て済みのチーム数cを添える。
$A_i < B_i$ なので、$B_i$ をキーに$A_i$の集合を得られるようにしておくと、$B_i$と相性の悪い、登録済みの$A_i$たちが取り出しやすい。

結果

import Data.Array
import qualified Data.IntSet as IS

abc310d :: Int -> Int -> Int -> [(Int,Int)] -> Int
abc310d n t m abs = loop 1 1 arr0
  where
    bads = fmap IS.fromList $ -- Bが苦手な、より番号が小さい人の集合
           accumArray (flip (:)) [] (1,n) $
           [(b,a) | (a,b) <- abs]
    arr0 = listArray (1,n) $ replicate n IS.empty
    loop k c arr
      | k > n = if c > t then 1 else 0
      | True  = sum
          [ loop (succ k) c1 arr1
          | d <- [1 .. min t c]  -- 人kをチームdに入れてみる
          , IS.null $ IS.intersection (bads ! k) (arr ! d) -- 衝突がなければ
          , let c1   = if c == d then succ c else c  -- cに入れたならcを進める
          , let arr1 = accum (flip IS.insert) arr [(d, k)]
          ]    

loopの引数の意味は以下のとおり。

loop :: Int                 -- 今からチームに入れる人の番号。N 超えで終了
     -> Int                 -- 次に新規割り当てするチーム番号。T 越えで打ち止め
     -> Array Int IS.IntSet -- 各チームの割り当て済みメンバー表
     -> Int                 -- 割り当てに成功した通りの数

この程度の問題なら、初めから、人の集合をビット集合で表しても書けそうだけど。

E - NAND repeatedly

問題 ABC310E

シグネチャを決める。

import qualified Data.ByteString.Char8 as BS

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

漸化式のとおりに、全ての開始位置 $1 \leq i \leq N$ から終了位置 $i \leq j \leq N$ までのビットを左からNANDをとり、その結果が1だった区間の個数を数えろと言っている。

$f$の値自体は0か1にしかならない。また、それまでの結果と、次の文字が何かだけで、次の結果は決まる。
つまり、全ての開始位置$i$からある位置$j$までの$f(i,j)$の結果が0である個数と1である個数がわかれば、$f(i,j+1)$の0の個数と1の個数は導ける。
そしてこの1の個数の総和が答え。

結果

import Data.List

abc310e :: Int -> BS.ByteString -> Int
abc310e _n s = sum $ snd $ mapAccumL step (0,0) $ BS.unpack s

-- (結果0の個数、結果1の個数) -> 次の文字 -> (0の個数と1の個数, 1の個数)
step (c0,c1) '0' = let c11 = c0 + c1 in (( 1, c11), c11)
step (c0,c1) '1' = let c11 = c0 + 1  in ((c1, c11), c11)

結果的にはscanlで遷移させても計算できたが、動いたのでこれでヨシ。

ByteStringの性能評価

単に1文字ずつ見て終わりならByteStringにする意味はなかったようにも見える。試しにStringに戻してみる。(⇒コード

時間(ms) メモリ(MB)
ByteString実装 75 7
String実装 114 34

BS.unpack がストリーム動作してくれて、[Char]をメモリに展開せずに済ませているのだろうか。

F - Make 10 Again

問題 ABC310F

シグネチャを決める。

abc310f :: Int    -- N
        -> [Int]  -- Ai
        -> Int    -- 答え
abc310f n as = ...

わからなくて解説を見た。

全てのサイコロの全ての目の場合の数を母数として、その中で、目を選んで10を作れる場合の割合を求めたい。しかし、それら全てを調査するのは手間が掛かりすぎる。
そこで、それぞれの場合を、「その目を選んで作れる数の集合」で同じものをまとめて考える。この集合は0を必ず含み、$\sum A_i$ 以下の値からなる。
一度に全てのサイコロを振る代わりに、1つずつ振り、この集合ごとに、その場合の数がいくつあるかを数えていく。つまり、作れる集合をキー、場合の数を値とする写像が、1つの段階を表す状態となる。

import qualified Data.Map as M
import qualified Data.IntSet as IS

type State = M.Map (IS.IntSet) Int -- 作れる数の集合 → 場合の数

1つもサイコロを振っていない段階は、$\{0\}$ が1通り、の対応だけがその状態である。

initial = M.singleton (IS.singleton 0) 1

集合$S$で表される場合にあるとき、$i$ 番目のサイコロを振り $1 \leq x \leq A_i$ の目が出たとすると、作れる数の集合は、$S$の各要素に$x$を足し合わせたものを追加したものとなる。
$$S' = S \cup \{ s + x \ |\ s \in S \}$$
写像にある全ての場合に対して、$x$を1から$A_i$まで振り、結果の全ての場合を足し合わせることで、$i$番目のサイコロを振った結果の状態が得られる。

step :: State  -- i-1まで振った状態
     -> Int    -- Ai
     -> State  -- iまで振った状態
step m ai = M.fromListWith (+)
  [ (IS.union s $ IS.map (x +) s, cnt)
  | (s, cnt) <- M.assocs m
  , x <- [1 .. ai]
  ]

全てのサイコロを振ったら、目標の10を含むような場合の数を合計する。

final = foldl step initial as
answer = sum [cnt | (s, cnt) <- M.assocs final, IS.member 10 s]

さて、10を超える要素に関して、「作れる数」の集合を詳しく区別する必要はない。そこで、それらを全て同一視する。
$$S' = S \cup \{ s + x \leq 10 \ |\ s \in S \}$$
すると、$x > 10$ に関して、$x$ ごとに場合の数を足す代わりに、まとめて $(A_i - x)$ 倍を足せばよい。これで、$A_i \leq 10^6$ という上限まで $x$ を振る必要もなくなる。

step m ai = M.fromListWith (+)
  [ (IS.union s $ IS.map (x +) s, cnt)
  | (s, cnt) <- M.assocs m
  , x <- [1 .. min 10 ai]
  ] ++
  [ (s, cnt * (ai - 10)) | ai > 10, (s, cnt) <- M.assocs m]

「0から10の整数が含まれる整数集合」を IntSet でなくビット集合で扱う。
すると、整数に割り当てられるので、Mapの代わりに配列で場合の数を数えられる。
また、この集合は全て0を含むので、10桁の1023までで済ませる。

結果

import Data.Array
import Data.Bits
import Data.List

type State = Array Int Int -- 作れる数のビット集合 → 場合の数

abc310f :: Int -> [Int] -> Int
abc310f n as = divm answer denom
  where
    initial = accumArray (+) 0 (0,ub) [(0,1)]
    final   = foldl' {-'-} step initial as
    answer  = foldl' {-'-} addm 0 [final ! i | i <- [512..ub]]
    denom   = foldl' {-'-} mulm 1 as

ub = 1023

step :: State -> Int -> State
step m ai = accumArray addm 0 (0,ub) $
  [ (s, mulm cnt (ai - 10)) | ai > 10, (s, cnt) <- assocs m] ++
  [ (bs2ix bs1, cnt)
  | (s, cnt) <- assocs m, let bs = ix2bs s
  , x <- [1 .. min 10 ai]
  , let bs1 = bs .|. (shiftL bs x .&. mask)
  ]

mask = 2047

-- 添え字からビット集合
ix2bs i = shiftL i 1 .|. 1
-- ビット集合から添え字
bs2ix b = shiftR b 1

-- モジュロ演算
modBase = 998244353
reg x = mod x modBase
addm x y = reg (x + y)
mulm x y = reg (x * y)
divm x y = powerish mulm x y (modBase - 2)
powerish mul i a b = foldl' {-'-} mul i [p | (b,p) <- zip bs ps, odd b]
  where
    bs = takeWhile (0 /=) $ iterate (flip shiftR 1) b
    ps = iterate (\x -> mul x x) a

結果:34ms, 5.5MB

ix2bs, bs2ix でチマチマやる代わりに、配列の要素の半分を無駄にする富豪的実装の方が速かった。(21ms, 6MB

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?