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?

ABC422 A~F をHaskellで

Last updated at Posted at 2025-09-14

25-9-14 Eを決定的に解く方法について追記

A - Stage Clear

問題 ABC422A

スーパーマリオか。
シグネチャを決める。

abc422a :: String -- S
        -> String -- 答え

2つの数値でなく文字列で入出力するのは、問題がそうなっているからではなくその方が都合が良いから。

結果

abc422a (a : _ :'8': _) = succ a : "-1"
abc422a (a : _ : b : _) = [a, '-', succ b]

B - Looped Rope

問題 ABC422B

タイトルの意味はなんだろう。
シグネチャを決める。

abc422b :: Int -- H
        -> Int -- W
        -> [String] -- Si
        -> Bool -- 答え

配列に仕舞って、条件を愚直に調べよう。

結果

import Data.Array.Unboxed

abc422b :: Int -> Int -> [String] -> Bool
abc422b h w ss = and [prop ij | (ij,True) <- assocs fld]
  where
    bnds = ((1,1),(h,w))
    fld = listArray bnds $ map ('#' ==) $ concat ss :: UArray (Int,Int) Bool
    prop (i,j) = flip elem [2,4] $ length
      [ ()
      | kl <- [(pred i,j),(succ i,j),(i,pred j),(i,succ j)]
      , inRange bnds kl
      , fld ! kl ]

C - AtCoder AAC Contest

問題 ABC422C

シグネチャを決める。テストケースひとつだけを考える。横着する。

abc422c :: [Int] -- nA,nB,nC
        -> Int   -- 答え

問題文の意味がしばらく理解できなかった。持っている文字を「使う」と「消費してなくなる」ということね。

$n_A, n_B, n_C$ は書きにくいので、$a,b,c$ と読み替える。

答えが $K$ だったとする。
そうするには、A, C がそれぞれまず $K$ 個ずつ、さらに後はどれでもいいので $K$ 個必要。
前半を式に直すと $K \leq a, c$
後半を式に直すと $(a - K) + b + (c - K) \geq K$, $a + b + c \geq 3K$
整理すると $K \leq a, c, (a + b + c)/3$

結果

abc422c [a,b,c] = minimum [a, c, div (a+b+c) 3]

二分探索とかするまでもなかったね。

D - Least Unbalanced

問題 ABC422D

シグネチャを決める。テストケースひとつだけを考える。横着する。

abc422d :: Int -- N
        -> Int -- K
        -> (Int, [Int]) -- 答え U, Bi

すんごい面倒くさい話が続いて、この「アンバランスさ」を長大な数列に対して求めろとか言われると思ったら、引数は2つだけだった。

時計を逆回しに考えると、最後に要素が $2^1$ の数列 $[A_1, A_2], A_1 + A_2 = K$ に関して、
そのアンバランスさ $|A_1 - A_2|$ を最小にするには、$K$ を二等分する、
$K$ が偶数ならアンバランスさ0、奇数なら1とすればよい。

以降、再帰的に、$N$ 回これを繰り返すことで長さ $2^N$ の数列ができあがる。

数列を作れたのはよいが、答えにはその数列のアンバランスさ $U$ も必要。
真面目に計算するとこれもなかなかに大変。
任意の数列でなく、アンバランスさを最小にするように、上の手順でつくられた数列だという性質を利用する必要があるだろう。

最後のステップで、アンバランスさは0または1になる。
0とはつまり左右の再帰で同じリストを作るので、片方だけのアンバランスさを気にすればよい。
1のとき左右の再帰で元になる数が1違うので、次のアンバランスさは即座にはわからない。

$K = 4i + 1$ の場合と $K= 4i + 3$ の場合に分けて考える。

$K = 4i + 1$ のとき、$K_1 = 2i, K_2 = 2i + 1$ に関して次の分割を行う。
$K_1$ を分けると $i, i$ になる。$K_2$ を分けると $i, i+1$ となる。結局、最大値ー最小値 は1になる。

$K = 4i + 3$ のとき、$K_1 = 2i + 1, K_2 = 2i + 2$ に関して次の分割を行う。
$K_1$ を分けると $i, i + 1$ になる。$K_2$ を分けると $i+1, i+1$ となる。結局、最大値ー最小値 は1になる。

どうやら、$K$ を二分割していくどこかで奇数になったら $U=1$ 一度もそうならなかったら $U=0$ となるだけのことらしい。
これはつまり、$K$ が $2^N$ で割り切れるなら $U=0$ さもなくば $U=1$ ということ。

結果

$2^20$ 要素の数列 $[B_i]$ を標準出力に吐き出すために、出力を ByteString.Builder で高速化する。
シグネチャも変更する。

import qualified Data.ByteString.Lazy as BS
import Data.ByteString.Builder

abc422d :: Int -> Int -> BS.ByteString
abc422d n0 k0 =
  toLazyByteString . mconcat .
  (char7 u :) . (char7 '\n' :) .
  intersperse (char7 ' ') . map intDec $ iter n0 k0 []
  where
    iter 0 k rest = k : rest
    iter n k rest =
      case divMod k 2 of
        (q, 0) -> iter (pred n) q $ iter (pred n)       q  rest
        (q, 1) -> iter (pred n) q $ iter (pred n) (succ q) rest

    u = if mod k0 (2 ^ n0) == 0 then '0' else '1'

E - Colinear

問題 ABC422E

シグネチャを決める。横着する。
直線がないとき空リスト、あるときa,b,cを順に持つリストを返す。

abc422e :: Int     -- N
        -> [[Int]] -- x_i,y_i
        -> [Int]   -- 答え [a,b,c] または []

過半数ということは、初期状態の順序を含めて任意の順序で点を並べたとき、
直線上にある2点が隣同士になっている箇所が少なくとも一箇所はある(末尾は先頭にループしているとする)ことになる。
なので 点1と点2を通る線、…、点Nと点1を通る線、のN本の線のどれかが答えになっているはず。

それらを確認するとき、残り $N-2$ 個の点について線上にあるか確認すると $O(N^2)$ で全然間に合わない。
$N$個の頂点がある直線上にあるかを $O(\log N)$ で判定するアルゴリズムなんてあるのか?と (@_@) になっていたのだが…

フレンズさんいわく

サーバル「E問題は乱択だよ。

なん、だと!?Strictなアルゴリズムをこよなく愛するこの私に乱択をやれと!抹茶ラテを作れと!(誤用)

N個の点群からランダムに異なる2点 i,j を選び、
$dx = x_j - x_i, dy = y_j - y_i$ として、その2点を通る直線 $dx (y - yi) = dy (x - x_i)$ に
全部の点の過半数が乗っているものがあれば、そのパラメータ
$a = dx, b = -dy, c = dx \cdot y_i - dy \cdot x_i$ を返す。
これらは制約 $|a,b,c| \leq 10^{18}$ には収まるのでそこは気にしなくてよい。

結果

AtCoder の System.Random が最新の 1.3 でなく 1.2 で、グルーが必要だった。
次の言語アップデートで解消されるだろうか。

import Data.List
import Data.Array.Unboxed
import System.Random
import Data.Tuple

abc422e :: Int -> [[Int]] -> [Int]
abc422e n xys = head $ cands ++ [[]]
  where
    n1 = pred n

    x, y :: UArray Int Int
    x = listArray (0,n1) $ map head xys
    y = listArray (0,n1) $ map (!! 1) xys

    m = 100
    (is,g1) = myUniformListR m (0,n1) $ mkStdGen 114514
    (js,_ ) = myUniformListR m (1,n1) g1

    cands =
      [ [dy, - dx, dx * yi - dy * xi]
      | (i,jj) <- zip is js, let j = mod (i + jj) n
      , let xi = x ! i, let yi = y ! i
      , let dx = x ! j - xi, let dy = y ! j - yi
      , div n 2 < length [() | xk : yk : _ <- xys, dx * (yk - yi) == dy * (xk - xi)]
      ]

-- glue
myUniformListR k r g = swap $ mapAccumL step g [1 .. k]
  where
    step g _ = swap $ uniformR r g

cands の計算の中心部、xys のリスト内包表記を length しているところ、
無限リストに対する null xs = 0 < length xs のような無駄があってくやしい。
手続き型なら、

  • オンラインな点の個数が過半数を超えたらそこで早抜け
  • そうでない点の個数が過半数を超えたらそこで打ち切り

という中断ができる。effect を使えばそういうこともきれいに書けたりしないのだろうか。

追記:決定的に解く方法

を見て感激してHaskellで実装した。
こういうのが真に価値のある記事というやつですね。

  • 点の番号は 0 〜 $N-1$ で管理する。
  • 考えている区間 $[p,q)$ を二分割して再帰的に計算する。
  • 区間の要素の個数が
    • 2のとき、その2点を通る直線が1つだけある
    • 3のとき、3つの点が一つの直線に乗っているなら、その1つの直線だけがある
    • そうでないとき、うち2点を通る直線が3つある
    • 4以上のとき、区間を二分割して再帰的に計算する
  • 結果は、直線のパラメータ $(a,b,c)$ を正規化したものをキーに、それを通る点の個数を値にしたマップとする
  • 再帰計算の結果は、次のように統合する
    • 両者のマップに共通するものは、個数を足し合わせる
    • 片方にだけ出現するものは、もう一方の点列で通るものの個数を数えて足し込む
    • 過半数を超える線だけ残す

再帰から戻って得られたマップに要素があるならそのキーを答えとして返せばおしまい。

import Data.Array.Unboxed
import qualified Data.Map as M
import qualified Data.Map.Merge.Strict as MMS

abc422e :: Int -> [[Int]] -> [Int]
abc422e n xys = head $ [[a,b,c] | (a,b,c) <- M.keys ans] ++ [[]]
  where
    n1 = pred n

    x, y :: UArray Int Int
    x = listArray (0,n1) $ map head xys
    y = listArray (0,n1) $ map (!! 1) xys

    ans = iter 0 n
    iter p q =
      case q - p of
        2 -> M.singleton (line p p1) 2
        3 | isOn pp1 p2 -> M.singleton pp1 3
          | otherwise   -> M.fromList [(abc, 2) | abc <- [pp1, line p1 p2, line p2 p]]
        _ -> MMS.merge wg1 wg2 wf (iter p m) (iter m q)
      where
        k = q - p
        p1 = succ p
        p2 = succ p1
        pp1 = line p p1
        m = div (p + q) 2
        wf = MMS.zipWithMaybeMatched f
        f _ d e
          | k < d1 + d1 = Just d1
          | otherwise   = Nothing
          where
            d1 = d + e
        wg1 = MMS.mapMaybeMissing (g m q)
        wg2 = MMS.mapMaybeMissing (g p m)
        g i j abc d
          | k < d1 + d1 = Just d1
          | otherwise   = Nothing
          where
            d1 = d + length (filter (isOn abc) [i .. pred j])
-- 線 (a,b,c) に点 i は乗っている
    isOn (a,b,c) i = a * x ! i + b * y ! i + c == 0
-- 点 i と点 j を通る線を正規化し、(a,b,c) で返す
    line i j
      | a1 < 0 = (- a1, - b1, - c1)
      | True   = (a1, b1, c1)
      where
        (xi, yi) = (x ! i, y ! i)
        (dx, dy) = (x ! j - xi, y ! j - yi)
        abc0 = [dy, - dx, dx * yi - dy * xi]
        g = foldl1 gcd abc0
        [a1,b1,c1] = map (flip div g) abc0

結果のマップのエレガントな統合に使った Data.Map.Merge.Strict.merge について簡単にまとめておく。

Data.Map.Strict.merge :: Ord k
  => (g1 m1にあってm2にないキーkについて、値aをどうするか)
  -> (g2 m2にあってm1にないキーkについて、値bをどうするか)
  -> (f  m1m2に共通するキーkについて、値a,bをどうするか)
  -> Map k a (m1)
  -> Map k b (m2)
  -> Map k c (答え)

zipWithMaybeMatched :: (k -> x -> y -> Maybe z) -> [fの型]
zipWith_____Matched :: (k -> x -> y ->       z) -> [fの型]

dropMissing     ::                        [gの型、全て捨てる]
preserveMissing ::                        [gの型、全て拾う、a,b == c のとき用]
filterMissing   :: (k -> x -> Bool)    -> [gの型, 選ぶ、a,b == c のとき用]
map_____Missing :: (k -> x ->       y) -> [gの型、全て拾う+変換、a,b  c のとき用]
mapMaybeMissing :: (k -> x -> Maybe y) -> [gの型、選ぶ+変換]

結果

時間 空間
乱択 1102ms 249MiB
決定的 415ms 156MiB

公式にも「乱択を使わない解法 by Yukkku」が追加されていた。

F - Eat and Ride

問題 ABC422F

シグネチャを決める。横着する。

abc422f :: Int     -- N
        -> Int     -- M
        -> [Int]   -- Wi
        -> [[Int]] -- u_i, v_i
        -> [Int]   -- 答え

考える

ダイクストラ法(改)

ダイクストラ法を、エージェントが一定速度でグラフを進んでいくメタファーで捉える。

  • エージェントが次のノードに到着する時刻をイベントとして、時刻順に処理する
  • エージェントが到着したとき、その頂点が未踏だった場合、距離が確定する
  • 接続している辺だけ、他の頂点に向かって、エージェントの分身が同時に出発する。到着イベントがキューに登録される
  • イベントが全て消化されたら完了

距離として、その頂点に到達するための燃料消費量を当てはめる。
これは辺の属性でなく、エージェントの現在の体重から導かれるので、エージェントに高橋くんの体重を属性として追加する。

さて、この問題のミソは、ある頂点に到達する異なる方法があって、
燃料消費量が少ないものと多いものであるとき、その頂点の答えは少ないものの方になるが、
高橋くんの体重が後者の方が軽いとき、この頂点からさらに先に進んだ頂点での答えは後者のものになることである。
ダイクストラ法で、単純に燃料消費量を距離として早い者勝ちにしてしまうと、後者を見落としてしまう。

そこで、キューの優先度にも手を入れる。
高橋くんの体重をキューの優先度の第1要素、燃料消費量を第2要素とする。
こうすることで、各頂点にエージェントが到着するのは体重順になる。
燃料は多く使ったが体重は軽い場合を先に処理すれば、
体重がより重いが燃料は節約できている場合で後から上書きできる。
つまり、早い者勝ちというルールも変更し、上書き可能にする。

結果

ノード数は5000上限なので、IntMapを擬似配列として使う。

import qualified Data.Heap as H
import Data.Array.Unboxed
import qualified Data.IntMap as IM

abc422f :: Int -> Int -> [Int] -> [[Int]] -> [Int]
abc422f n _m ws uvs = IM.elems distZ
  where
    wa = listArray (1,n) ws :: UArray Int Int -- ノード到着で追加される重み
    g = accumArray (flip (:)) [] (1,n) $      -- いつものグラフ
        [(u,v) | u:v:_ <- uvs] ++ [(v,u) | u:v:_ <- uvs] :: Array Int [Int]
    dist0 = IM.empty
    distZ = loop dist0 $ H.singleton $ H.Entry (0, 0) 1 -- Entry (重量, コスト) 位置 : 位置に到着したときのコストと重量
-- ダイクストラ法
    loop dist queue
      | H.null queue = dist              -- 探索終了
      | dv < d    = loop dist  queue1       -- キュー先頭は不要
      | otherwise = loop dist2 queue2
      where
        Just (H.Entry (w, d) v, queue1) = H.uncons queue -- キュー先頭を取り出し
        w1 = w + wa ! v  -- 到着で重量が増える
        d1 = d + w1      -- 次に進んだときにそこに付けるコスト
        dv = dist .! v   -- vの最小コスト記録
        queue2 = H.union queue1 $ H.fromList [H.Entry (w1, d1) u | u <- g ! v, d1 < dist .! u]
        dist2 = IM.insert v d dist

    im .! i = IM.findWithDefault maxBound i im

提出, 81ms, 17MiB

公式解説のやり方

フレンズさんいわく

サーバル「F問題は主客転倒だよ!
頂点iで増えた体重の影響はこの後の移動回数分だから、行動回数を決め打ちしてDPすればいいね。
219Hが少し難しい類題だから挑戦してみてね」

ひとつだけの公式解説の内容も多分これと同じことを言っていて、
別解のユーザ解説がまったく付いていない。
これは、上の解法が嘘解法なのではなかという不安感をかきたてられる。

コードまで調べてないけど、全ての提出の結果を眺めていると、
1桁, 2桁msでメモリも少なく終わっているものと、
500~1000msかかってメモリもたくさん使っているものとに分かれている感じ。
前者がダイクストラ法、後者がこの主客転倒DPを使っているのではと想像される。

考え方

  • 元のグラフの頂点 $u$ と、移動券の残り枚数 $0 \leq k < N$ に対して $(u,k)$ という頂点を持つグラフを考える。
  • 元のグラフの辺 $(u,v)$ に対して、$(u, k)$ から $(v, k-1)$ への重み $k W_u$ の辺を張る。
  • $(1, 0 \leq k < N)$ を全てスタート頂点とする。
  • $(1 \leq i \leq N, 0)$ のスタート地点からの最短距離が答え

これは、元のグラフだけを使って、移動券0枚~$N-1$ 枚の全ての場合に関して別々に、
移動券を使い切った地点での最短距離を各頂点について求めてから、
移動券の初期枚数について串刺し集計して最短距離を求めるという手順を重ね合わせたDPになっている。

また、グラフは、券の枚数に関して単調減少する向きにしか辺がないため合流はあってもループはなく、
券の枚数の多い頂点から順に各位置に関して最短距離を確定させていくことができ、計算量を節約できる。

実装1

一方通行で値が確定するのなら、遅延配列による暗黙の集めるDPが使える。
ということでやってみる。
提出:TLE(+MLE) 2323ms, 1890MiB
要素数が多すぎるようだ。

実装2

上の実装は時間計算量 $O(NM)$ 空間計算量も $O(NM)$ で、解説とは空間計算量が食い違っている。
「券の枚数の大きい方から順に確定する」のだから、券の枚数 $k$ の表だけから券の枚数 $k-1$ の表が作成でき、
最後に必要なのは券の枚数 0 枚の最後の表だけなので、そのように計算する必要がある。

集めるDPを計算の順序を考えて丁寧に実装する。

import Data.Array.Unboxed

abc422f :: Int -> Int -> [Int] -> [[Int]] -> [Int]
abc422f n _m ws uvs = elems cost0
  where
    n1 = pred n
    tooBig = div maxBound 2 :: Int
    wa = listArray (1,n) ws :: UArray Int Int -- ノード到着で追加される重み
-- 残り歩数kの層ごとの遅延しない配列による集めるDP
-- をfoldl'で n1 から 0 まで降りることで、確実にeagerに作る
    cost0 :: UArray Int Int
    cost0 = foldl' step costN1 [n1, pred n1 .. 1]
    costN1 = listArray (1, n) $ 0 : repeat tooBig
    step cost k1 = accumArray min tooBig (1,n) $ ((1, 0) :) $ concat
      [ [ (v, cost ! u + k1 * wa ! u)            -- (u,k) から (v,k-1) へ集める
        , (u, cost ! v + k1 * wa ! v)]           -- (v,k) から (u,k-1) へ集める
      | u:v:_ <- uvs ]                          -- 辺 (u,v) について

提出:AC, 471ms, 18MiB

十分速いが、ダイクストラ法ベースの解法の方がもっと速い。

G - Balls and Boxes

フレンズさんいわく

サーバル「G問題はFPSの入門問題だね。Nyaanさんの丁寧な解説があるから、FPSに入門するチャンスだよ!」

圧巻の公式解説。勉強します。

2
0
1

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?