A - N-choice question
シグネチャを決める。
abc300a :: Int -- N
-> Int -- A
-> Int -- B
-> [Int] -- Ci
-> Int -- 答え
正解となる選択肢は必ず一つだけ存在する、と保証されているので、それを探せばよい。
結果
abc300a n a b cs = head [i | (c,i) <- zip cs [1..], c == a + b]
B - Same Map in the RPG World
シグネチャを決める。
abc300b :: Int -- H
-> Int -- W
-> [String] -- Aij
-> [String] -- Bij
-> Bool -- 答え
大した大きさではないので、全てのずらし量に関して試してみてもよい。
幅の上限30は、32ビット整数にビット列で入れても間に合う大きさで、その方が比較が高速にできる。
リストを回転させてどこかで一致するかを探す prop は、
prop xs ys = not $ null
[ ()
| d <- [0..pred $ length xs]
, let (as,bs) = splitAt d xs
, bs ++ as == ys
]
と書けるが、つまり、(xs,ysの長さをl、ずらし量をdとして）
-
ysの前方がdrop d xsと等しい -
xsの前方がdrop (l-d) xsと等しい
ということなので、isPrefixOf により (++) を消せる。
結果
import Data.Bits
import Data.List
abc300b :: Int -> Int -> [String] -> [String] -> Bool
abc300b h w ass bss = any prop $ take w $ iterate (map (rot w)) ans
where
ans = map s2b ass
bns = map s2b bss
-- リストを0～h-1回転させるとbssと一致
prop xs = not $ null
[ ()
| d <- [0..pred h]
, isPrefixOf (drop d xs) bns
, isPrefixOf (drop (h-d) bns) xs
]
-- 一行の文字列をビット表現に変換
s2b :: String -> Int
s2b = foldl step 0
where
step x c = shiftL x 1 .|. if c == '#' then 1 else 0
-- 幅Wのビット列を1ビット右回転
rot :: Int -> Int -> Int
rot w n = shiftR (if even n then n else setBit n w) 1
C - Cross
シグネチャを決める。
abc300c :: Int -- H
-> Int -- W
-> [String] -- Cij
-> [Int] -- 答え
素直にグリッドの様子を二次元配列に入れておき、
全てのグリッドをバツ印の中心と仮定して、その大きさを測定した結果を大きさごとにカウントする。
結果
import Data.Array
abc300c :: Int -> Int -> [String] -> [Int]
abc300c h w css = elems cnts
where
-- グリッドの内容
g = listArray ((1,1),(h,w)) [c == '#' | cs <- css, c <- cs]
-- 添え字がはみ出しても大丈夫なgのアクセサ
f i j = 0 < i && i <= h && 0 < j && j <= w && g ! (i, j)
-- 全ての位置についてバツ印の大きさを測った結果をカウントする
cnts = accumArray (+) 0 (1, min h w)
[ (s, 1)
| i <- [1..h], j <- [1..w]
, let s = size i j, s > 0]
-- 中心i,jのバツ印の大きさを測る
size i j
| not $ f i j = 0
| otherwise = loop i j 1
loop i j d
| grow = loop i j (succ d)
| otherwise = pred d
where
grow = f (i-d) (j-d) && f (i-d) (j+d) &&
f (i+d) (j-d) && f (i+d) (j+d)
D - AABCC
シグネチャを決める。
abc300d :: Int -- N
-> Int -- 答え
$i$ 番目の素数を $p_i$ と表す。
素因数分解して $a^2 \cdot b \cdot c^2 \ (a < b < c)$ となる数の個数、ということなので、異なる$a,b,c$の組に関して重複する心配はない。素直に数えればよい。
$N \leq 10^{12}$ は大きく感じるが、$a,b,c$に当てはまるような素数はつまり$10^6$以下で、そのような数が素数か判定するには$10^3$までの素数だけが必要なので、問題の大きさは見た目より小さい。
- 素数$a$を小さい方から順に試し、個数の総和をとる
- 素数$b > a$を順に試し、個数の総和をとる
- 素数$c> b$を順に試し、
- $a^2 \cdot b \cdot c^2 \leq N$ となる $c$ の個数を数える
- 素数$c> b$を順に試し、
- 素数$b > a$を順に試し、個数の総和をとる
最後のところで、一つずつ試すのは無駄なので、$c^2 \leq N / a^2 / b$ を満たす $c$ の個数を一度に数えるには、$a, b$ の最小値が $2,3$ なので、$c^2 \leq N / 12$ までの素数を番号付きで記録しておき、
数える代わりに、この条件を満たす最大の$c = p_k$、そのときの$b=p_j$のとき、$c$になれる素数の個数は$k - j$と求められる。
$b$を試す範囲は、$k - j \geq 0$となるところ。
$a$を試す範囲は、$a = p_i, b = p_{i+1}, c = p_{i+2}$ と最小の選択をしたときに $a^2 \cdot b \cdot c^2 \leq N$ となる範囲。
結果
import qualified Data.IntMap as IM
import Data.Maybe
import Data.List
abc300d :: Int -> Int
abc300d n = sum
[ sum $ takeWhile (0 <) $ map (countC a) bjs
| (a,_):bjs <- takeWhile acond $ tails $ zip primes [1..]
]
where
n12 = div n 12
-- (使う範囲の)素数の番号を引けるIntMap
pm = IM.fromAscList $ zip (takeWhile ((n12 >=) . (^ 2)) primes) [1..]
-- aの探索範囲か判定
acond ((a,_):(b,_):(c,_):_) = a * a * b * c * c <= n
-- a, b (=pj) に対する c の個数
countC a (b, j) =
maybe 0 (max 0 . subtract j . snd) $
IM.lookupLE cmax pm
where
cmax = floor $ sqrt $ fromIntegral n / fromIntegral (a * a * b) -- ここはsqrtで妥協
primes :: [Int]
primes = 2 : 3 : [x | w <- [5,11..], x <- [w, w+2], isPrime x]
isPrime :: Int -> Bool
isPrime x = all ((0 /=) . (mod x)) $ takeWhile ((x >=) . (^ 2)) primes
リスト内包表記は、生成器が作った候補を採用するか却下するかはガードで選択できるが、生成器の生成を外から終了させるような機構がないので、このように、生成器側に takeWhile で停止条件を盛り込む、あまりスマートでないやり方でしのいでいる。命令型のループなら強制脱出してしまえば済むのに、もう少し何とかならないかと思う。
E - Dice Product 3
シグネチャを決める。
abc300e :: Int -- N
-> Int -- 答え
- $\times 1$ では、数は変化しない。
- $\times 2$ では、素因数2が1つ増える。
- $\times 3$ では、素因数3が1つ増える。
- $\times 4$ では、素因数2が2つ増える。
- $\times 5$ では、素因数5が1つ増える。
- $\times 6$ では、素因数2と3が1ずつ増える。
1から始めて、これらの操作で$N$に到達するには、$N$がもともと、素因数として$2,3,5$のみを持つものである必要がある。そうでないときはどうやっても到達できない。
$N = 2^p \cdot 3^q \cdot 5^r$ とする。
3次元の格子状のマスを考え、初期位置 $(0,0,0)$ に到達する確率が 1、サイコロによる遷移を考え、$N$の位置$(p,q,r)$ に到達する確率を求めたい。
あるマス$(x,y,z)$にいるときに、サイコロを振って、1が出たら移動しない、2が出たら$(x+1,y,z)$、3が出たら$(x,y+1,z)$、4が出たら$(x+2,y,z)$、5が出たら$(x,y,z+1)$、6が出たら$(x+1,y+1,z)$に移動する。これらの確率は均等に1/6だが、1が出て足踏みをした場合も、最終的にはそれ以外の目を出して他に移動する確率が均等なので、結局1/5の確率で他に移動するとみなしてよい。
上の「進む」で考えると配るDPになるが、あるマスに直接侵入する経路はそれらを逆にしたものになり、集めるDPでも素直に考えればよい。
結果
import Data.Array
import Data.List
abc300e :: Int -> Int
abc300e n
| s /= 1 = 0 -- 2^p*3^q*5^r の形でないとき
| otherwise = arr ! (p,q,r)
where
p:q:r:s:_ = pfloop n 0 [2,3,5]
bnds = ((0,0,0),(p,q,r))
arr = listArray bnds $ map f $ range bnds
neighbors x y z = sum $
[arr ! (pred x,y,z) | x > 0] ++ -- 2
[arr ! (x,pred y,z) | y > 0] ++ -- 3
[arr ! (x-2 ,y,z) | x > 1] ++ -- 4
[arr ! (x,y,pred z) | z > 0] ++ -- 5
[arr ! (pred x,pred y,z) | x > 0, y > 0] -- 6
f (0,0,0) = 1
f (x,y,z) = mul recip5 $ neighbors x y z
recip5 = modRecip 5
-- 2,3,5だけで割り尽くしてp,q,rを求め、残った値sと共に[p,q,r,s]にして返す
pfloop n 0 [] = [n]
pfloop n c dds@(d:ds) =
case divMod n d of
(q,0) -> pfloop q (succ c) dds
_ -> c : pfloop n 0 ds
modBase = 998244353
reg x = mod x modBase
mul x y = reg $ x * y
-- モジュロ逆数
modRecip a = powerish mul 1 a (modBase - 2)
powerish mul 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