LoginSignup
2
0

More than 1 year has passed since last update.

ABC276 A~F をHaskellで

Last updated at Posted at 2022-11-06

Rated参加でズタボロでした。

A - Rightmost

問題 ABC276A

シグネチャを決める。

abc276a :: String  -- S
        -> Int     -- 答え

「最後に a が見つかった位置」を、それが見つかるたびに更新して、最後に残った値がそれ。
初期値を -1 にしておけば、見つからなかった場合も対応できる。

結果

abc276a s = foldl step (-1) $ zip s [1..]

step _ ('a', pos) = pos
step pos _ = pos

B - Adjacency List

問題 ABC276B

シグネチャを決める。

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

隣接リストとしてグラフを読み込む方法の練習。

結果

import Data.Array
import Data.List

abc276b :: Int -> Int -> [(Int,Int)] -> [[Int]]
abc276b n m abs = [length as : sort as | as <- elems g]
  where
    g = accumArray (flip (:)) [] (1,n)
        [p | (a,b) <- abs, p <- [(a,b),(b,a)]]

C - Previous Permutation

問題 ABC276C

シグネチャを決める。

abc276c :: Int    -- N
        -> [Int]  -- Pi
        -> [Int]  -- 答え

例をよく見ると、要素の大きさを逆順にして、「次の順列」を求めたものがそれになっている。

3 1 2 -- 元
1 3 2 -- 逆
2 1 3 -- 次
2 3 1 -- 逆

9 8 6 5 A 3 1 2 4 7 -- 元
2 3 5 6 1 8 A 9 7 4 -- 逆
2 3 5 6 1 9 4 7 8 A -- 次
9 8 6 5 A 2 7 4 3 1 -- 逆

Haskell では Data.Vector(.Unboxed).Mutablenext_permutation がある。

結果

import qualified Data.Vector.Unboxed as UV
import qualified Data.Vector.Unboxed.Mutable as MUV

abc276c :: Int -> [Int] -> [Int]
abc276c _ = map negate . nextPermutation . map negate
 
nextPermutation :: [Int] -> [Int]
nextPermutation ps = UV.toList $ UV.create $ do
  mv <- UV.thaw $ UV.fromList ps
  MUV.nextPermutation mv
  return mv

別解 next_permutationに頼らない

5 2 4 3 1 の「次」は何か。10進数と同じように、下の桁から増やすことを考える、ただし、上の桁で使用済みの数字は使えない、もしくは「今使っていい範囲の数字」しか使えない。
下1桁の 1 は、1 しか使えないのて、増やすことはできない。
下2桁の 3 1 は、13 の並べ替えでこれが最大である。4 3 2 も同様。
2 4 3 1 で初めて、この桁をより大きな数字に入れ替える候補がある。それは 3 なので、この桁に 3 を入れて 3 ? ? ? とする。残りの桁には、今使える数字 2 4 1 での最小の列を収めればよい。それは昇順の並びであるので結局 3 1 2 4 となり、5 3 1 2 4 が元の列の「次」となる。

同様に考えて、「前」を作るには、下の桁から見て、大きな数字になっている桁までを取り出してくる。その数字より小さな最大の数字に差し替え、残りの数字を降順に並べ替えたら出来上がり、となる。

import Data.List

abc276c :: Int -> [Int] -> [Int]
abc276c n ps = last
  [ qs ++ r3 : rs1 ++ rs2
  | (qs, rs@(r1:r2:_)) <- zip (inits ps) (tails ps)
  , r1 > r2
  , let (rs1, r3:rs2) = span (>= r1) $ sortBy (flip compare) rs
  ]

D - Divide by 2 or 3

問題 ABC276D

シグネチャを決める。

abc276d :: Int    -- N
        -> [Int]  -- ai
        -> Int    -- 答え

割り切れる場合に限って2または3で割ることができて、最終的に全て同じ値になるということは、その最終結果 $g$ に対して、全ての項が $a_i = g \cdot 2^x \cdot 3^y$ と書けるということである。
そのような最終結果 $g$ で最大のものは $A$ の最大公約数である。
そして、$a_i / g$ を2と3で割れるだけ割ったら1になるはずである。
この割る回数の総和を求める。ただし途中で、割り切っても1にならない数があったら失敗となる。

結果

import Data.List

abc267d :: Int -> [Int] -> Int
abc276d n as
  | all (1 ==) bs = sum cs
  | otherwise     = -1
  where
    g = foldl1 gcd as
    (cs, bs) = unzip
      [ (c2 + c3, a3)
      | a <- as
      , let a1 = div a g
      , let (c2, a2) = divCnt a1 2
      , let (c3, a3) = divCnt a2 3
      ]

divCnt x p = loop 0 x
  where
    loop cnt x =
      case divMod x p of
        (q, 0) -> loop (succ cnt) q
        _      -> (cnt, x)

E - Round Trip

問題 ABC276E

シグネチャを決める。

abc276e :: Int           -- H
        -> Int           -- W
        -> [ByteString]  -- Cij
        -> Bool          -- 答え

重なりのない経路を、長さ4以上で探す。「長さ4」とは、Sを0ステップめとして、4ステップめもSなので、そうでない途中は3マスあればよい。つまり、下図のような経路で構わない。

.12
.S3

ということは、出発の向きと到着の向きが異なるようにすれば長さ4あることは保証され、重なりがなくてその距離が出せることも保証される。

このような経路があるかどうかは、上下左右の4か所から出発する幅優先探索を行うか、UnionFindで連結成分を見つけて、上下左右のどこかが互いに繋がっているかを見つけ出せばよい。

結果

Union-Find大好きなのでそれで解く。
マスに0から$HW-1$の番号を振り、横または縦に隣接する全ての2マスの組について、どちらも . ならば(# だけでなく S も通り抜けできないとする)同じ枠に入れる。

abc276e h w css = length p4 > length (nub r4)
  where
    h1 = pred h
    w1 = pred w
-- マス (i,j) は '.' か
    isDot i j = BS.index (csv V.! i) j == '.'
-- マス (i,j) の番号
    addr i j = i * w + j
-- 横に並んだ '.' の組
    hori =
      [ (p, p + w)
      | i <- [0..pred h1], j <- [0..w1]
      , isDot i j, isDot (succ i) j
      , let p = addr i j ]
-- 縦に並んだ '.' の組
    vert =
      [ (p, succ p)
      | i <- [0..h1], j <- [0..pred w1]
      , isDot i j, isDot i (succ j)
      , let p = addr i j]
-- UnionFind
    uf = foldl uniteUF (newUF $ h * w) (hori ++ vert)
-- 'S' の位置
    (si,sj) = head
      [(i,j) | i <- [0..h1], j <- [0..w1], BS.index (csv V.! i) j == 'S']
-- 'S' に隣接する4マス、(isDotは不要)
    p4 = [addr (pred si) sj |  0 < si, isDot (pred si) sj ] ++
         [addr (succ si) sj | si < h1, isDot (succ si) sj ] ++
         [addr si (pred sj) |  0 < sj, isDot si (pred sj) ] ++
         [addr si (succ sj) | sj < w1, isDot si (succ sj) ]
-- 4マスの代表点
    r4 = map (getRoot uf) p4

-- UnionFindはシグネチャのみ、実装は略
type UnionFind = ...
newUF :: Int -> UnionFind
getRoot :: UnionFind -> Int -> Int
uniteUF :: UnionFind -> (Int, Int) -> UnionFind

Union-FindをMutable Vectorで実装した版でACしたが、immutable版でもいけるだろう。

F - Double Chance

問題 ABC276F

シグネチャを決める。

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

期待値とは、それぞれの場合について、そのスコアにその場合の確率を掛けたものの和である。
$K$ 枚の中から2枚のカードを引くとき、全ての組み合わせが同じ確率で出るので、それぞれの場合のスコアの総和を $K^2$ で割れば(モジュロ逆元を掛ければ)期待値になる。
2枚のカードが $A_i, A_j$ のときにそのスコアは $\max(A_i, A_j)$ というルールである。
縦横 $N$ マスの表で、それぞれの組み合わせのスコアが考えられる。

___1___ ___2___ ___3___ ___4___
1 $\max(A_1,A_1)$ $\max(A_1,A_2)$ $\max(A_1,A_3)$ $\max(A_1,A_4)$
2 $\max(A_2,A_1)$ $\max(A_2,A_2)$ $\max(A_2,A_3)$ $\max(A_2,A_4)$
3 $\max(A_3,A_1)$ $\max(A_3,A_2)$ $\max(A_3,A_3)$ $\max(A_3,A_4)$
4 $\max(A_4,A_1)$ $\max(A_4,A_2)$ $\max(A_4,A_3)$ $\max(A_4,A_4)$

カード $K$ 枚について考えるときは、この表の左上 $K$ 行 $K$ 列だけを使う。
また、その和だけが必要である。
カード $K-1$ 枚についてこの表の和が得られているとする。
次に $K$ 枚について考えるときは、$A_K$ に絡む1行と1列だけが追加される。
その総和は
$$S_K = A_K + 2 \sum_{i=1}^{K-1} \max(A_K, A_i)$$
である。
つまり、$K$ より手前の全ての $A_i$ に対して $\max$ をとって総和をとればよい…とやると、$O(N^2)$ になって TLE する。もっと効率よくこの値を求めることが要求される。

$A_i \leq A_K$ のとき、$\max(A_K, A_i) = A_K$ である。つまり、「$A_1$から$A_{K-1}$ の中で、$A_K$以下であるものの個数がわかれば、それに $A_K$ を掛ければそれらの $\max$ の総和となる。
$A_K < A_i$ のとき、$\max(A_K, A_i) = A_i$ である。つまり、「$A_1$ から $A_{K-1}$ の中で、$A_K$より大きいものの総和、を手早く求めたい。

これは「セグメント木」または「フェニック木」を使うとできる。「木」という名前だが、データ列の区間に対する演算と、列の要素の置き換えをどちらも $O(\log N)$ で実行できる。
まず、$A_1$ から $A_N$ を整列し、それぞれの $A_i$ が小さい方から $j$ 番めである、という順位を調べておく。
要素数$N$、演算は足し算、初期値は全て0というセグメント木を二つ用意する。
$A_i$ を調べた後、セグメント木の $j$ 番めの要素を、片方の木は1、もう片方の木は $A_i$ に更新する。
$A_i$ より手前にある、大きさ $A_i$ 以下の要素の個数は、1を入れるセグメント木の $1$ から $j$ までの和で得られる。
$A_i$ より手前にある、大きさが $A_i$ を超える要素の総和は、$A_i$ を入れるセグメント木の $j+1$ から $N$ までの和で得られる。

結果

セグメント木を IOVector で実装したので、IOアクションになった。
また、$K \times K$ の表の和が求められたら、後は割り算で答えを出力できるため、リストで結果を返す代わりに、問題を解くIOアクションの途中で答えを出力してしまう形にした。

import Data.Array
import Data.Bits
import qualified Data.Vector.Unboxed.Mutable as MUV

abc276f :: Int -> [Int] -> IO ()
abc276f n as =
  do
-- 1を入れるセグメント木
    st1 <- makeSegTree (+) 0 n
-- Aiを入れるセグメント木
    stA <- makeSegTree add 0 n
-- K=0の表の和は0から始めて、K = 1~N を順に計算し、出力する
    loop 0 st1 stA $ zip3 [1..] as js
  where
-- Aiのセグメント木における添え字(=Aiの小さい順の順位)を求める
-- (Ai,i) をソートすればよいが、N ≦ 2*10^5 = 0x30D40 は18ビットなので、
-- 18ビット左シフトさせて空けた場所にiを突っ込んで一つの整数で扱う
    js = elems $ array (0, pred n) $
         flip zip [0..] $ map ((2^18 - 1) .&.) $
         sort [shift a 18 .|. i | (a,i) <- zip as [0..]]
-- メインループ
    loop :: Int -> SegmentTree Int -> SegmentTree Int -> [(Int,Int,Int)] -> IO ()
    loop _ _ _ [] = return ()
-- Akの順位はj、それ以前の情報がセグメント木 st1, stA に入っている
-- 手前までの表の総和が acc
    loop acc st1 stA ((k, a, j):kajs) =
      do
        lows  <- querySegTree st1 0 j
        highs <- querySegTree stA j n
        let acc1 = summ [acc, a, 2 * highs, mul (a * 2) lows]
        writeSegTree st1 j 1
        writeSegTree stA j a
        print $ modDiv acc1 (mul k k)
        loop acc1 st1 stA kajs

-- モジュロ演算

modBase = 998244353
reg x = mod x modBase
add x y = reg (x + y)
mul x y = reg (x * y)
summ :: [Int] -> Int
summ = foldl add 0

-- モジュロ除算、モジュロ逆元を求める拡張ユークリッド互除法の改造版
modDiv b a = powerish b a (modBase-2)
  where
    mul x y = mod (x * y) modBase

-- @gotoki_no_joe
powerish i a b = foldl' {-'-} mul i [p | (True, p) <- zip bs ps]
  where
    bs = map odd $ takeWhile (0 <) $ iterate (flip div 2) b
    ps = iterate (\x -> mul x x) a

-- セグメント木 実装は省略

data SegmentTree a = SegmentTree Int (a->a->a) a (STree a)

type STree a = MUV.IOVector a

-- 演算op、単位元かつ初期値u、要素数N(添え字は0からN-1) なセグメント木を作る
makeSegTree :: MUV.Unbox a => (a->a->a) -> a -> Int -> IO (SegmentTree a)
makeSegTree op u len = ...

-- 位置 j の要素をxに更新
writeSegTree :: MUV.Unbox a => SegmentTree a -> Int -> a -> IO ()
writeSegTree (SegmentTree w op _ vec) j x = ...

-- 位置 a から b (bは含まない)の範囲の計算結果
querySegTree :: MUV.Unbox a => SegmentTree a -> Int -> Int -> IO a
querySegTree (SegmentTree w op u vec) a b = ...

省略のない版はこちら

愚痴

Cを真面目にやろうとして身構えてしまい、後回しにしてやる時間を失った。
Eの「距離4」が、上に示した「すぐ戻ってくる」ものではダメだと思い込み、また制約の $H \times W \leq 10^6$ を $H, W \leq 10^6$ (つまりマスの数が最大 $10^{12}$)と思い込み、幅優先探索もUnionFindも諦めてしまった。(考えてみれば、そんなサイズの迷路の地図を読み込むだけで大変なことになる。)
Fは、immutableな版のセグメント木を使ったこと、小さい側の数の個数も(別の)セグメント木で数えられることに気づかず、Data.IntSet.split で整数集合を分割して下側の要素数を数えるというやり方で求めようとして、時間内には TLE から抜け出せなかった。最後に悪あがきでノーチェック提出して CE まで食らってしまった。

EのUnion-FindやFのセグメント木は、手持ちの実装がなければとても時間内には解けないので、「競技プログラミング慣れ」を要求された回だったな、と。ACLにはどちらもあるから無問題、ということなのだろうか。

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