A - Wrong Answer

問題 ABC343A

シグネチャを決める。

abc343a :: Int  -- A
        -> Int  -- B
        -> Int  -- 答え
abc343a 0 0 = 1
abc343a _ _ = 0

$(A,B) = (0,0)$ が、正解が$A+B=0$となる唯一の場合で、そのときだけ0でない値、さもなくば0を出しておけば要求は満たせる。

B - Adjacency Matrix

問題 ABC343B

シグネチャを決める。

abc343b :: Int -- N
        -> [[Int]] -- Aij
        -> [[Int]] -- 答え

つまり、それぞれの行について、1になっている列の番号をもつリストを作る。

結果

abc343b n ass = [[j | (j, 1) <- zip [1..] as] | as <- ass]

C - 343

問題 ABC343C

シグネチャを決める。

abc343c :: Int -- N
        -> Int -- 答え

$10^{18}$という数字で脅しにかかっているが、3乗してそのような数になる$x$は$10^6$以下の数なので、全て試しても間に合う。

結果

abc343c n = last $ takeWhile (n >=)
            [k | x <- [1..], let k = x ^ 3, let s = show k, s == reverse s]

D - Diversity of Scores

問題 ABC343D

シグネチャを決める。

abc343d :: Int     -- N
        -> Int     -- T
        -> [[Int]] -- Ai,Bi
        -> [Int]   -- 答え

各選手の現在の得点を追跡するのは当然として、同時に、その値を集めた多重集合も管理する。
それは IntMap で実装し、個数を値とする。
各時刻での答えは IntMap の size だが、これは $O(N)$ かかるポンコツなので、さらに同時に、多重集合のキーの個数も追跡する。

結果

結果は状態の一部でもあるため、mapAccumLでは冗長になるのでscanlで済ませた。

import qualified Data.IntMap as IM

abc343d :: Int -> Int -> [[Int]] -> [Int]
abc343d n t abs = map fst $ tail $ scanl step (1, (IM.singleton 0 n, IM.empty)) abs
  where
    -- cnt0 現在の種類数
    -- va0  得点の多重集合
    -- sc   各選手の得点配列
    step (cnt0, (va0, sc)) (ai:bi:_) = (cnt2, (va2, sc1))
      where
        s0 = IM.findWithDefault 0 ai sc  -- Aiの現在の得点
        s1 = s0 + bi                     -- Bi増えた得点
        sc1 = IM.insert ai s1 sc         -- 配列に書き戻し
        (cnt1, va1) = case IM.lookup s1 va0 of        -- 得点siがひとつ増える
          Nothing -> (succ cnt0, IM.insert s1 1 va0)  -- 初出なら個数も増える
          Just m  -> (cnt0, IM.insert s1 (succ m) va0)
        (cnt2, va2) = case va0 IM.! s0 of             -- 得点s0がひとつ減る
          1 -> (pred cnt1, IM.delete s0 va1)          -- ラス1なら個数も減る
          m -> (cnt1, IM.insert s0 (pred m) va1)

E - 7x7x7

問題 ABC343E

シグネチャを決める。

abc343e :: Int   -- V1
        -> Int   -- V2
        -> Int   -- Ai,Bi
        -> [Int] -- 答え a1～c3 解なしなら空リスト

辺が座標軸に平行、と明記しないと、3次元では格子点どうしを斜めにつないで距離7にできるらしい。ぎゃー。

向きがまっすぐな直方体どうしなら、角の座標の比較で、公差部分やその体積は容易に計算できる。
$[-100,+100]$で総当たりすると大きすぎるが、もっと狭くて十分。

探索範囲を狭くしすぎるとひっかかるトラップが仕掛けてあって、テストケースががっちり設計されていて偉いなと思いました。

結果

細かい計算が合わなくて、公式解説のコードを移植しました。

import Data.List
import Control.Monad

abc343e :: Int -> Int -> Int -> [Int]
abc343e v1 v2 v3
  | valid     = head $ cands ++ [[]]
  | otherwise = []
  where
    valid = v1 + v2 * 2 + v3 * 3 == 3 * 7 * 7 * 7  -- 計算が合うか
    c1 = [0,0,0]
    cands =
      [ c1 ++ c2 ++ c3
      | c2 <- replicateM 3 [-1..7]
      , let v12 = isVol [c1, c2]
      , c3 <- replicateM 3 [-1..7]
      , v3 == isVol [c1, c2, c3]
      , v12 + isVol [c2, c3] + isVol [c3, c1] == v2 + 3 * v3
      ]

-- intersection volume
-- 立方体の下端の座標リストから、共通部分の体積を求める
isVol :: [[Int]] -> Int
isVol cs = product $ zipWith (\a b -> max 0 (7 + a - b)) (map minimum tcs) (map maximum tcs)
  where
    tcs = transpose cs

F - Second Largest Query

問題 ABC343F

区間の最大値とその個数、次点の値とその個数、という4つの値を要素に持つセグメント木を考える。
単独の値 $A_i$については、$((A_i, 1), (0, 0))$ とする。
二つの区間を合流させるときは、マージソートのマージのような計算をする。

Unboxed IOVectorを使って 582ms, 55MB でACできた。

G - Compress Strings

問題 ABC343G

シグネチャを決める。

import qualified Data.ByteString.Char8 as BS

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

わからないのでアライさんにヒントをもらう。

アライグマ「G問題は、どの文字列の次にどの文字列をつなげるかを考えるとTSPになるのだ！」

なるべく重なりがでるように繋げていけということね。
その重なりの量も、上手に数えないと時間が足らなそう。
例1の uk のように埋もれてしまう文字列、例2の abc のように重複する文字列も厄介そう。

考える

（といっても、公式解説のコードがきれいにまとまっているのでかなり参考にした。）

重なり長さ

二つの文字列$S_i, S_j$について、$S_i$の後半と$S_j$の前半が一致するその最大の長さを効率的に求めたい。
文字列を検索するKMP法を応用できないか考えてみる。
文字列検索アルゴリズムは、パターンがテキスト中に見つかったときは、照合できたパターンの開始位置を返し、パターンがテキストからはみ出したときは失敗で終わるという動作をする。
これを、パターンの照合中にテキストの末端に到達したときは、そのときに途中までマッチしたパターンの長さを返す、テキストの途中でパターン全体のマッチに成功したならばパターンの長さを返す、という風に少しだけ動作を改変すると、ここで欲しい「重なり長さ」と、それ以前に（例1のukのような）埋没する文字列かの判定も実現できる。

そんなわけで、pediaの擬似コード algorithm kmp_search を改変しつつHaskellに翻訳してみるとこんな感じ：

kmpSearch :: BS.ByteString -> BS.ByteString -> Array Int Int -> Int
kmpSearch pat text tbl = loop 0 0
  where
    plen = BS.length pat
    tlen = BS.length text
    loop m i
      | i == plen     = i -- パターンを全て照合できた
      | m + i == tlen = i -- パターン途中でテキスト終端に到達した
      | charMatch     = loop m (succ i) -- 次の文字へ
      | otherwise     = loop (m + i - ti) (if i > 0 then ti else 0) -- リセット
      where
        charMatch = BS.index pat i == BS.index text (m + i)
        ti = tbl ! i

最後の引数 tbl は「部分マッチ」テーブルで、$S_i$について作っておいて$N-1$回使い回す。
それを作る手続きの擬似コード algorithm kmp_table もHaskell化したいが、フォールバックのときに作り中のテーブルの内容を読み取っていて、これが動作に必要なので遅延配列で作ることもできないのが苦しい。mutable arrayを嫌って(!!)で実現してみる。

kmpTable :: BS.ByteString -> Array Int Int
kmpTable pat = listArray (0, pred plen) tbllist
  where
    plen = BS.length pat
    tbllist = -1 : 0 : loop 2 0
    loop i j
      | i == plen = []
      | charMatch = succ j : loop (succ i) (succ j)
      | j > 0     =          loop       i  (tbllist !! j)
      | otherwise =      j : loop (succ i)  j
      where
        charMatch = BS.index pat (pred i) == BS.index pat j

包含される文字列を取り除く

KMPができたので、$S_i$の全ての組み合わせについて重なり長さを求める。
このとき、自分自身に対する結果は自分の長さになるので、それも後で使うからとっておく。

-- ovs ! (i, j) Sjの末尾とSiの先頭の重なる長さ
    ovs :: Array (Int,Int) Int
    ovs = listArray ((1,1),(n,n))
          [ if i == j then BS.length si else kmpSearch si sj t
          | (si,i) <- zip ss [1..], let t = kmpTable si
          , (sj,j) <- zip ss [1 :: Int ..]
          ]

そして、完全に重なる相手がある文字列を今後の考慮から取り除く。
これが、$S_i = S_j$のとき両方とも取り除いてしまわないようにするのがなかなか書けなかった。
deleteとか使っていてナニだけど、$N \leq 20$なのでここでは問題にならない。

-- 埋まってしまう（同一を含む）文字列を除去した、扱うべき背番号のリスト
    is = foldl' instep [1..n] [1..n]
    instep js i = if any prop js then delete i js else js
      where
        prop j = i /= j && ovs ! (i,j) == ovs ! (i,i)
-- isの要素に0始まりの背番号を振り直す
    nn = pred $ length is
    uf = listArray (0, nn) is :: Array Int Int
--- 番号を振り直したovs
    uovs i j = ovs ! (uf ! i, uf ! j)

トラベリングセールスマン問題

このuovsを使って、使用済みの文字列の番号集合と末尾の番号をキーに、その最短長さを値にした配列を構築するDPをする。

先頭の文字列は自分の長さがコスト
それ以外は、自分の長さ－手前の文字列との重なり長さ＋手前までの重ね文字列の長さが最小になるように手前を選ぶ

    bsmax = pred $ 2 ^ succ nn  -- ビット集合の最大値
    bnds = ((1,0), (bsmax, nn)) -- 配列の添え字はビット集合と末尾の番号
    lenA = listArray bnds $ map lenF $ range bnds :: Array (Int,Int) Int
    lenF (bs, i)
      | invalid   = maxBound   -- bsにiがない組み合わせは無意味
      | bs1 == 0  = uovs i i   -- iのみのとき、Siの長さ
      | otherwise = uovs i i + minimum cands -- iの手前jを総当たりで、jまでの長さ+Siの長さ-重なり長 の最小値
      where
        invalid = not $ testBit bs i
        bs1 = clearBit bs i
        cands = [lenA ! (bs1, j) - uovs i j | j <- [0..nn], testBit bs1 j]

答え

lenAの最後の行の最小値が答え。

abc343g n ss = minimum [lenA ! (bsmax, i) | i <- [0..nn]]
  where
    ...

ただ残念なことに、この遅延配列による暗黙のDPによる解は5秒あっても間に合わない。

集合のビット表現は添え字の小さい方から確定する性質を利用して、STArrayで順に値を埋めていくスタイルでどうにか4757ms, 177MBで間に合った。