(1/22 13:00 Fが解けたので追記。）
A - Range Swap
シグネチャを決める。手抜きする。
abc286a :: [Int] -- N,P,Q,R,S
-> [Int] -- Ai
-> [Int] -- 答え Bi
後ろから操作すると位置がずれない。
結果
abc286a [n,p,q,r,s] as = a1 ++ a4 ++ a3 ++ a2 ++ a5
where
(a1234,a5) = splitAt s as
(a123 ,a4) = splitAt (pred r) a1234
(a12 ,a3) = splitAt q a123
(a1 ,a2) = splitAt (pred p) a12
B - Cat
「連続して」含まれる、という言い回しは微妙な気がする。
シグネチャを決める。
abc286b :: Int -- N
-> String -- S
-> String -- 答え
結果
abc286b n = loop
loop ('n':'a':s) = 'n':'y':'a':loop s
loop (c:s) = c : loop s
loop "" = ""
C - Rotate and Palindrome
シグネチャを決める。
abc286c :: Int -- N
-> Int -- A
-> Int -- B
-> String -- S
-> Int -- 答え
文字列を折りたたんで合わせてみて、異なる箇所の数 $\times B$ 円で回文にできる。
ローテートを $k$ 回してから折りたたむ場合、$kA$ 円余計にかかる。
$N \leq 5000$ なので総当たりでやる。
とはいえ、リストのままでするのは効率が悪そう、配列に置いてやるのでは命令型言語のコードと変わり映えしないので、Data.Sequence を使ってみよう。
結果
import qualified Data.Sequence as Q
import Data.List
abc286c :: Int -> Int -> Int -> String -> Int
abc286c n a b s =
minimum $ -- 5.最小値を選ぶ
zipWith (+) [0, a ..] $ -- 4.回転のコストを加えて
map ((b *) . cost) $ -- 3.合わせる文字数のコストを求めて
take n $ -- 2.元に戻るまで全ての場合で
iterate rotate (q1, q2) -- 1.ひたすら回転させ
where
(s1,s2) = splitAt (div (succ n) 2) s
q1 = Q.fromList s1 -- 前半分
-- q2 = Q.fromList $ reverse s2 -- 後ろ半分の逆向き
q2 = foldl' (flip (Q.:<|)) Q.Empty s2
-- q1の左端→q2の左端, q2の右端->q1の右端 で回転
rotate (a1 Q.:<| q1, q2 Q.:|> am) = (q1 Q.|> am, a1 Q.<| q2)
-- 二つの列で一致しない位置の個数を数える
cost (q1, q2) = loop q1 q2 0
where
loop (a Q.:<| q1) (b Q.:<| q2) c = loop q1 q2 $ if a == b then c else succ c
loop _ _ c = c
-- cost = length . Q.findIndicesL id . uncurry (Q.zipWith (/=))
Sequenceは効率がそれほど良くないため、cost関数の手作業での最適化は効果があった。
D - Money in Hand
シグネチャを決める。
abc286d :: Int -- N
-> Int -- X
-> [(Int,Int)] -- Ai, Bi
-> Bool -- 答え
$\sum Bi$ 個の荷物を選んで、スコア $\sum Ai$ をちょうど $X$ にできるか、というナップザック問題。
Data.IntSet を信じて力任せにする…
import qualified Data.IntSet as IS
abc286d :: Int -> Int -> [(Int,Int)] -> Bool
abc286d n x abs = IS.member x s
where
s = foldl step (IS.singleton 0) abs
step s _ | IS.member x s = s
step s (a, b) = IS.unions $ take (succ b) $ iterate (IS.map (a +)) s
とテストケース2つだけTLEした。
$X$ を超える値は作らないようにだけ工夫する。
結果
import qualified Data.IntSet as IS
abc286d :: Int -> Int -> [(Int,Int)] -> Bool
abc286d n x abs = IS.member x s
where
s = foldl step (IS.singleton 0) abs
step s _ | IS.member x s = s
step s (a, b) = IS.unions
[ IS.fromDistinctAscList $ take (succ b) $ takeWhile (x >=) [i, i+a ..]
| i <- IS.elems s
]
E - Souvenir
直行便のある都市 $S$ から都市 $T$ への移動を、重み $(1, -A_S)$ な辺として、重みが最小な経路を探す。$U$ から $V$ に重みの総和 $(K,A)$ で移動できるとき、直行便の本数は $K$、お土産の価値の総和は $A_V - A$ となる。
$N \leq 300$ なので、ワーシャルフロイド法を想定していると考えられる。
ワーシャルフロイド法でするなら、クエリの対応に入る前にほとんどの計算は終わっているが、クエリごとに計算を行うスタイルにしてみる。
という前提でシグネチャを決める。
import Data.Array.IO
import Data.Array
type DA = IOArray (Int,Int) (Int,Int) -- 距離の表
-- 前処理
abc286ep :: Int -- N
-> [Int] -- Ai
-> [String] -- Si
-> IO DA -- 距離の表
-- クエリ対応
abc286em :: DA -- 距離の表
-> Array Int Int -- Ai
-> Int -- Ui
-> Int -- Vi
-> IO String -- 答え
結果
import Control.Monad
abc286ep n as ss = do
arr <- newListArray ((1,1),(n,n)) $
[ if sij == 'N' then (maxBound, 0) else (1, - ai)
| (si,ai) <- zip ss as, sij <- si]
forM_ [1..n] (\k ->
forM_ [1..n] (\i -> do
dik <- readArray arr (i,k)
when (dik < (maxBound, 0)) (
forM_ [1..n] (\j -> do
dkj <- readArray arr (k,j)
when (dkj < (maxBound, 0)) $ do
let dikj = add dik dkj
dij <- readArray arr (i,j)
when (dij > dikj) $ writeArray arr (i,j) dikj
)
)
)
)
return arr
add (a,b) (c,d) = (a+c,b+d)
abc286em arr aa i j = do
(k, a) <- readArray arr (i,j)
return $ if k == maxBound then "Impossible" else unwords [show k, show $ aa ! j - a]
クエリ対応の段階では距離の表は書き変えないため、前処理の配列に Data.Array.ST を用いて、runSTArray で immutable な配列を返すようにした版はTLE した。
上のコードは、純粋配列への変換をあきらめて、IOArray で保持し続ける形に変更しただけなのだが、これで普通に間に合う。
F - Guess The Number 2
解けたので追記。壁に突き当たったのでアライさんのヒントを見た。
いつもだと、$A$ と大きな $N$ を与えられて、$B_i = f^N(i)$ を求めるのに、べき乗を二進数で高速化する方法をするような問題設定で、$A$ をこちらが与えて、相手の $N$ を当てろという、立場の逆転した話。
$f(i) = A_i$ は関数なので移動先は一つに決まり、有向グラフは、終点がないので必ずループになり、また合流がありうるが、分岐はない。
長さ $P$ のループがあるとき、ループの中の頂点から始めて $N$ ステップ移動したら、ループを $Q$ 周してさらに $R$ 進んだ位置で止まったとすると、$N = PQ + R$ である。ここで $P$ が操作可能、$R$ は観測可能、$Q$ は不明で $N$ が目的変数である。
$Q$ が不明なのが厳しく感じられるが、$M \leq 110$ の許す範囲で異なる長さのループを複数作ってそれぞれの余りを数えると、中国剰余定理で $N$ を特定できる。
この問題で中国剰余定理を使って $N$ を求めるには、互いに素な整数群で、和が $110$ 以下で積が $10^9$ 以上となるものが必要である。
> :m + Data.Numbers.Primes
> :m + Data.Set
> step s k = union s $ fromList [(p0*k,s1,k:ps) | (p0,s0,ps) <- elems s, let s1 = s0 + k, s1 <= 110]
> s = Data.List.foldl' step (singleton (1,0,[])) $ takeWhile (110 >=) primes
> maximum s
(340510170,110,[29,23,17,13,11,7,5,3,2])
> compare 340510170 (10^9)
LT
あれ？足らない。
方向性はあってるけど、素数でない数も使って110以下に抑えるその数の組み合わせがある、っていうのはどこから出てくるの…
> step s k = union s $ fromList [(l1,s1,k:ps) | (l0,s0,ps) <- elems s, let l1 = lcm l0 k, l1 /= l0, let s1 = s0 + k, s1 <= 110]
> s = Data.List.foldl' step (singleton (1,0,[])) [110,109..2]
> [e | e@(l,_,_) <- elems s, l >= 10^9]
[(1338557220,108,[4,5,7,9,11,13,17,19,23])]
ふわぁ。（なお [2..110] で探すと無限に時間がかかる）
フェーズ1
上で見つけたループ長をなす $A_i$ を固定的に出力すればよい。
import Data.List
theList = [4,5,7,9,11,13,17,19,23]
as = concat $ snd $ mapAccumL step 1 theList
where
step b l = (b+l, take (pred l) [succ b..] ++ [b])
phase1 = do
print 108
putStrLn $ unwords $ map show as
フェーズ2
受け取った $B_i$ のうち、ループ先頭の位置の値（と元の値との差）だけが必要になる。
phase2 :: [Int] -> Int
phase2 bs = ...
where
bs1 = map (bs !!) $ init $ scanl (+) 0 theList
rs = zipWith (-) bs1 $ scanl (+) 1 theList
...
作り置きの中国剰余定理を計算する関数がこちら。
import Control.Monad
-- @gotoki_no_joe
crt :: [(Int,Int)] -> Maybe (Int,Int)
crt = foldM step1 (0,1)
where
step1 (r0,m0) (r1,m1)
| m0 < m1 = step2 (mod r1 m1) m1 r0 m0
| otherwise = step2 r0 m0 (mod r1 m1) m1
step2 r0 m0 r1 m1
| mod m0 m1 == 0 = if mod r0 m1 == r1 then Just (r0, m0) else Nothing
| r /= 0 = Nothing
| otherwise = Just (r0 + x * m0, m0 * u)
where
(g,im) = invGCD m0 m1
(q, r) = divMod (r1 - r0) g
u = div m1 g
x = mod (mod q u * im) u
invGCD :: Int -> Int -> (Int, Int)
invGCD a b
| a1 == 0 = (b, 0)
| otherwise = loop b a1 0 1
where
a1 = mod a b
loop s 0 m0 m1 = (s, if m0 < 0 then m0 + div b s else m0)
loop s t m0 m1 = loop t (s - t * u) m1 (m0 - m1 * u)
where
u = div s t
答えはあるに決まっているので決め打ちする。
phase2 :: [Int] -> Int
phase2 bs = ans
where
bs1 = ...
rs = ...
Just (ans,_) = crt $ zip rs theList