LoginSignup
3
1

ABC345 A~F をHaskellで

Posted at

ゾロ目とかの回は遊びが入るものだと思ったけど、345はスルーだった。

A - Leftrightarrow

問題 ABC345A

シグネチャを決める。

abc345a :: String -- S
        -> Bool   -- 答え
abc345a s = head s == '<' && dropWhile ('=' ==) (tail s) == ">"

B - Integer Division Returns

問題 ABC345B

シグネチャを決める。

abc345b :: Int  -- X
        -> Int  -- 答え

公式解説にあるように、整数除算がどちらに丸めるかは流儀があって、pedia-剰余演算-実際のプログラミング言語の挙動と、pedia-除法-参考文献にあるDivision and Modulus for Computer Scientistsに色々書いてある。

Haskellは div-mod ペアと quot-rem ペアでどちらの流儀にも対応できる。

結果

公式解説では、除数-1を足してから割る云々で、除算をした結果がそのまま答えになるようにしようと頑張っているが、余りも見れば難しく考えなくてもいい。

modは除数(ここでは+10)と同じ符号になるということは、商については切り捨て丸めをするということなので、剰余が出たら切り上げればよい。

abc345b x =
  case divMod x 10 of
    (q, 0) -> q        -- 割り切れたらそのまま
    (q, _) -> succ q   -- 余りが出たら1増やす

C - One Time Swap

問題 ABC345C

シグネチャを決める。

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

数えない場合を引く方法

Qiitaの数式モードの都合(アンダースコアが続くと変になる)で、高校数学の$_n C_k$を$C(n,k)$と書く。

任意の2カ所 $1 \leq i < j \leq N$ を選ぶやり方は $C(N,2)$ 通りある。
ここで、$i$文字めと$j$文字めが異なる文字ならば、元の$S$とも、他の$(i,j)$の選択とも異なる結果を得る。
そうでなく、$i$文字めと$j$文字めが同じ文字になってしまった場合、$S$のままになるので、そのような場合を数えるとそれは、アルファベット各文字$c$の個数を$K_c$としたとき $\sum_c C(K_c,2)$ である。これを全体から引けばよい。
ただし、そのような場合が一つでもある場合、$S$がそのまま、という場合を数えて1足す必要がある。

import Data.Array

abc345c :: String -> Int
abc345c s = nC2 (sum cs) - sum (map nC2 cs) + if any (1 <) cs then 1 else 0
  where
    cs = elems $ accumArray (+) 0 ('a','z') [(c,1) | c <- s]
    nC2 n = div (n * pred n) 2

数える場合だけを数える方法

$i$ 文字めが $c$ で、$j$ 文字めが $c$ と異なる文字のとき、結果は$S$と異なる文字列になる。
文字 $c$ になる $i$ の場合は $K_c$ とおり、文字 $c$ にならない $j$ の場合は $N - K_c$ とおり、とやると、$i > j$ の場合も含めて倍数えてしまうので、後で2で割る。
また、$S$がそのまま出てくる場合の補正も、上と同様にする。

abc345c s = div (sum [c * (n - c) | c <- cs]) 2 + if any (1 <) cs then 1 else 0
  where
    cs = elems $ accumArray (+) 0 ('a','z') [(c,1) | c <- s]
    n = sum cs

公式解説、ユーザ解説の方法

$(N^2 - \sum_c K_c^2)/2$ (補正の1を除く) となるらしい。

abc345c s = div (n * n - sum (map (^ 2) cs)) 2 + if any (1 <) cs then 1 else 0
  where
    cs = elems $ accumArray (+) 0 ('a','z') [(c,1) | c <- s]
    n = sum cs

D - Tiling

問題 ABC345D

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

abc345d :: [Int]    -- N,H,W
        -> [[Int]]  -- Ai, Bi
        -> Bool     -- 答え

マス目の並びを、上の行から順に埋めていくことを考える。
次に置くタイルは、まだ残っている最も上の行で、最も左の角に合わせて配置する。
すると、置き場所は一意に定まる。
どのタイルを置くかが、たかだか$N \leq 7$とおり、タテかヨコかで2通りなので、
$7 \cdot 2 \cdot (6 \cdot 2 \cdot ( \dots (1 \cdot 2) \dots ) = 7! \cdot 2^7 = 645,120$ 通りは、そのままやればよい。

マス目の状態を表すやり方として、Array (Int,Int) Bool とか持ち出さなくても、「それぞれの列ごとに、下から何マス空いているか」の一次元配列 Array Int Int だけで十分である。

結果

import Data.Array

abc345d :: [Int] -> [[Int]] -> Bool
abc345d [n,h,w] abs = recur arr0 abs
  where
    arr0 = listArray (1,h) $ replicate h w
    recur arr abs
      | p == 0    = True
      | otherwise = or
        [ recur arr1 (delete ab abs)    -- 5.再帰的に探索
        | ab@(a:b:_) <- abs         -- 1.タイルを選ぶ
        , (x,y) <- [(a,b),(b,a)]    -- 2.タテまたはヨコに
        , x <= p, y <= r            -- 3.置けるなら
        , let arr1 = arr // [(i, p - x) | i <- [q .. q + pred y]] ] -- 4.盤面を更新して
      where
        (p,q,r) = findmax arr

-- 最大値、開始位置、続く個数、を取り出す
findmax :: Array Int Int -> (Int,Int,Int)
findmax arr = foldr step (0,0,0) $ assocs arr
  where
    step (i,h) (a,b,c)
      | a == h, succ i == b = (a, i, succ c) -- 延長
      | a <= h              = (h, i, 1)      -- 記録更新またはより左
      | otherwise           = (a, b, c)      -- 変更なし

E - Colorful Subsequence

問題 ABC345E

シグネチャを決める。$C_i, V_i$ は横着する。

abc345e :: Int      -- N
        -> Int      -- K
        -> [[Int]]  -- Ci, Vi
        -> Int      -- 答え

考える

素朴なDP

単純なDPを考えると、左から順に調べていき、$i$個めまで見た $score_i[k,c]$を

  • ボールを除いた個数($0 \leq k \leq K$)
  • 列の末尾のボールの色($0 \leq c \leq 10^5$) (0は、前がないことを表す)

ごとの価値の合計の最大値として、全体を走査してこれを更新したら、$\max_c score_N[K,c]$ が答えとなりそうに思える。しかしこの配列を更新するには、$j = i+1$ 個めのボールを

  • 無視する場合に対応して $score_j[k,c]$ の候補に $score_i[k-1,c]$ がある
  • 選ぶ場合に対応して $score_j[k,C_j]$ の候補に $V_j + score_i[k,c] \ (c \neq C_j)$ がある

中から、最大値を選ぶことになる。つまり
$score_j[k,C_j] = \max(score_i[k-1,C_j], V_i + \max_{c \neq C_i} score_i[k,c])$
$score_j[k,c \neq C_j] = score_i[k-1,c]$
となる。添え字$k$について+1ずらし、添え字$C_j$の要素のみ、それ以外の全ての色の値の最大値を探す、という集めるDPになる。
しかし、最大値を求める回数が多すぎてこれでは間に合わない。

スコアで色を順序づけ

$score_i[k,c] = W_{ikc}$を純粋な二次元配列で持つ代わりに、$W_{ikc}$の値の大きい順に、それがどの色のスコアかを添えた優先度付きキューで、$score_i[k] = [ (W_a, C_a), \dots ]$ という形で持つことを考える。
すると、上のステップ更新は、$score_i[k-1] \ni (W_j, C_j)$, $score_i[k]$ の $C_j$ でない最大値を $(W_x, C_x)$ として、
$score_j[k] =$ $score_i[k-1]$ のキューの $(W_j,C_j)$ を $(\max(W_j, V_j + W_x), C_j)$ に置き換えたもの
とすることになり、また、最終結果は $score_N[K]$ の先頭の値となる。
しかし、色の種類分の長さのキューを全部なぞって$(W_j, C_j)$を探し出す計算は重そうだ。

富士山と北岳

さらにここで、キューは全ての色について持っておく必要はなく、最大スコアとその色、二番手のスコア(同着あり)とその色、の先頭二つだけを持っていれば済む。
$score_i[k] = [(W_a,C_a), (W_b,C_b), \dots]$ とする。$C_a \neq C_b$ である。
「$score_i[k]$の$C_j$でない最大値$(W_x,C_x)$」を見つけるには、$C_j \neq C_a$ ならば $W_a$, さもなくば(つまり$C_a = C_j$ つまり $C_b \neq C_j$ なので)$W_b$ を選べばよい。

もう一つの操作として $(W_j, C_j)$を探し出す必要があるように見えるが、続きの置き換えまで合わせて読むと「$(W_j, C_j)$も含む$score_i[k-1]$のキューに、$W_j < V_j + W_x$ ならば $(V_j+W_x, C_j)$を挿入する。」そしてその先頭2要素だけに注目すると、
$score_i[k-1] = [(W_p,C_p),(W_q,C_q),\dots]$ から、

  • $C_p = C_j$ のとき、$[(\max(W_p, V_j+W_x), C_j),(W_q,C_q)]$ に置き換え
  • $C_q = C_j$ のとき、$[(W_p, C_p),(\max(W_q, V_j+W_x,), C_j)]$ を降順にソート
  • どちらでもないとき、$[(W_p, C_p),(W_q,C_q),(V_j+W_x, C_j)]$ を降順にソートし3位は退場

で$score_j[k]$ は作れるとわかる。つまり、$W_j$が上位2名に入っていなければ考慮する必要はなく、入っていたときに3位以下の情報が必要になったりもしない。

結果

上位2名を連れていこうとして1人しかいないとか、誰もいないような場合にも対応させるプログラミングをして、

キュー代数的データ型

data TOP2 = E0                      -- 空
          | E1 (Int,Int)            -- ぼっち
          | E2 (Int,Int) (Int,Int)  -- 2名在籍

で表現し、細かく計算を seq で促したら
4292ms, 63MB でギリACした。

4項組で

  • $(-1,0,-1,0)$ : 空
  • $(w,c,-1,0)$ : ぼっち
  • $(w_1,c_1,w_2,c_2)$ : 2名在籍

として、これを Unboxed Vector に入れたら
1022ms, 67MB で堂々ACした。

F - Many Lamps

問題 ABC345F

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

abc345e :: [Int]       -- N,M,K
        -> [[Int]]     -- ui, vi
        -> Maybe [Int] -- 答え

全域森

わからなくてフレンズさんのヒントを見た。

Union-Findをとって全域木を作ろうとして全部連結にならなくても気にしなくてよくて、全域森の辺の本数が1になった葉uについて、そこから出る辺をeとして、

  • ランプが点いているときは、uとeはもう使わない。
  • ランプが消えているならeを使って点灯させて、反対側の頂点vのランプも反転させる。使い終わった辺eは森から取り除いて、それによってvが持つ辺が減る。ここでvは葉になることがある。
    このときvが消えたなら、点灯しているランプの個数は変化しない。点いたなら、2個増える。

を繰り返して、Kまでつけられれば勝ち。
なお、ランプは偶数個しかつけられないので、奇数を指定されたら即アウトにできる。

公式解説のやり方

全域森を作るのに、深さ優先探索でグラフを貪欲に走査し、またこの探索における再帰の戻りとは葉から根に向かう向きなので、このときにその辺を消費する計算も同時に行う、とてもコンパクトなコードが公式解説に掲載されている

のだけど、23行めから33行めで、無名関数を作ってdfsに入れて、それが再帰的に自分を呼び出せるように第1引数に入れて34行めでdfs(dfs,i)として呼び出す、というC++独特の書き方を避けて、もっとprimitiveなpseudo codeに近い書き方で解説は書いてほしい。

多分、実行時に要素を確保するvectormain()の中で作って、それをdfsから大域的にアクセスしようとすると、こうやるのが楽だからなんだろうけども。

このアプローチをHaskellに翻案した。

import qualified Data.Vector.Unboxed.Mutable as MUV
import Control.Monad.ST
import Data.Array

abc345f :: Int -> Int -> Int -> [[Int]] -> Maybe [Int]
abc345f _ _  0 _ = Just []          -- 0は即座に成功
abc345f _ _  k _ | odd k = Nothing  -- 奇数は即座に失敗
abc345f n _m k uvs = runST $
  do
    vis  <- MUV.replicate n1 False -- ノードが調査済みかのフラグ
    lamp <- MUV.replicate n1 False -- ノードのランプが点灯中かのフラグ
    (rest, ans) <- foldM (\ra c -> snd <$> dfs vis lamp ra c) (k, []) [1..n]
    return $ if rest == 0 then Just ans else Nothing
  where
    n1 = succ n
    g = accumArray (flip (:)) [] (1,n) [p | (i, u:v:_) <- zip [1..] uvs, p <- [(u,(v,i)),(v,(u,i))]] -- 頂点に接続する辺の番号リスト G
    dfs :: STArray s Int Bool -- vis
        -> STArray s Int Bool -- lamp
        -> ( Int              -- rest ランプ残り
           , [Int])           -- acc 使った辺リスト
        -> Int                -- c 訪問する頂点
        -> ( Bool             -- c は初訪問だった
           , (Int,[Int]))     -- (rest,acc)の更新値
    dfs _is _amp ra@(0,_) _ = return (False, ra) -- 目標達成済みなら何もしない
    dfs vis lamp ra c = do    -- 頂点cからのDFSを試みる
      vc <- MUV.read vis c
      if vc then return (False, ra) else do -- 既に訪問済みなら失敗で直帰
        MUV.write vis c True       -- cに訪問済みの印を付ける
        ra3 <- foldM (\ra1 (d, i) -> do  -- cから辺iで接続されるdについてdfsを広げる
          (vd, ra2@(rest2, acc2)) <- dfs vis lamp ra1 d  -- dへ行って戻る
          if not vd || rest2 == 0 then return ra2 else do   -- d訪問が失敗もしくは目標達成済みならこれ以上何もしない
            ld <- MUV.read lamp d
            if ld then return ra2 else do       -- dが点灯しているなら何もしない
              MUV.write lamp d True             -- 消えているなら点ける 辺iを使う
              lc <- not <$> MUV.read lamp c     -- cも反転させる
              MUV.write lamp c lc
              return $ if lc then (rest2 - 2, i : acc2) else (rest2, i : acc2) -- cが点いたなら2減らす
          ) ra (g ! c)
        return (True, ra3)

C++でdfsをくくりだすと

void dfs(int c) {
    vis[c] = true;
    for (auto& [d, id] : G[c]) {
        if (vis[d]) continue;
        dfs(d);
        if (rest <= 0) return;
        if (lamp[d]) continue;
        lamp[d] = true;
        lamp[c] = ! lamp[c];
        if (lamp[c]) { rest -= 2; }
        ans.push_back(id);
    }
}

これで済むので、(全容はこちら)なんとも。

vis, lamp と大域変数 rest, acc を引数で取り回さず、RWSモナドとレンズでキレイに隠して ST モナドに重ねて書く、とか出来れば、もうすこし見た目が何とかなるのかしら。

(ずっとREに悩まされた原因が、辺データを$M$個読むべきところ$N$個読んでいた、という読み込み部の凡ミスだった。道理で本体をどれだけ読んでもおかしいところはない訳だよ!)

G - Sugoroku 5

フレンズさんいわく

アライグマ「G問題はFPS講座なのだ……」

公式解説もユーザ解説もやばみが溢れているので、こんな危険な場所からは早く逃げた方がいい。

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