A - Doors in the Center
シグネチャを決める。
abc398a :: Int -- N
-> String -- 答え
- $N$ が奇数のとき、
=が中央に1文字、前後に-が $(N-1)/2$ 文字ずつ - $N$ が偶数のとき、
=が中央に2文字、前後に-が $N/2-1 = (N-2)/2$ 文字ずつ
という文字列を作ればよい。
整数除算における切り捨てにより、-の長さは同じやり方で計算できる。
結果
abc398a n
| even n = s ++ "==" ++ s
| otherwise = s ++ '=' : s
where
s = replicate (div (pred n) 2) '-'
B - Full House 3
シグネチャを決める。
abc398b :: [Int] -- Ai
-> Bool -- 答え
リストで解く
同じカードの枚数を数え、枚数の多い方から2つを考える。
最大の方が3枚以上、次点が2枚以上あれば、フルハウスを作れる。
import Data.List
abc398b :: [Int] -> Bool
abc398b as =
case sortBy (flip compare) $ map length $ group $ sort as of
a:b:_ -> a >= 3 && b >= 2
_ -> False
配列によるカウントで解く
同じカードの枚数を数える。
次に、同じカードの枚数が2枚以上である数の種類数、3枚以上である数の種類数を数える。
後者は前者に含まれるため、前者が2つ以上、後者が1つ以上あることがフルハウスを作れる条件である。
import Data.Array
abc398b :: [Int] -> Bool
abc398b as = count 2 >= 2 && count 3 >= 1
where
cnt = accumArray (+) 0 (1,13) [(a,1) | a <- as] :: Array Int Int
count x = length $ filter (x <=) $ elems cnt
C - Uniqueness
シグネチャを決める。
abc398c :: Int -- N
-> [Int] -- Ai
-> Int -- 答え
アライグマ「dict[x]=xを持ってるヒトの番号の集合、みたいな辞書を作ったり、Aiをソートしたりすればいいのだ！」
両方やってみる。
辞書を作る方法
数 $A_i$ をキーに、その数を持っている人の番号 $i$ のリストを値とする IntMap を作る。
リストが単一要素な最大のキーの、そのリストの内容が答えである。
番兵を忍ばせておく。
import qualified Data.IntMap as IM
abc398c :: Int -> [Int] -> Int
abc398c n as = head cands
where
im = IM.fromListWith (++) $ (minBound, [-1]) : [(a,[i]) | (a,i) <- zip as [1 ..]]
cands = [i | (_a, [i]) <- IM.toDescList im]
ソートする方法
つい、$A_i$ に $i$ を添えてソートしたくなるが、答えは唯一な $A_i$ の $i$ なので、後で探し直せばいい。計算量は変わらない。
import Data.List
abc398c :: Int -> [Int] -> Int
abc398c _n as = ans
where
[ai] = head $ filter isSingleton $ group $ sortBy (flip compare) $ minBound : as
Just ans = lookup ai $ (minBound, -1) : zip as [1 ..]
isSingleton :: [a] -> Bool
isSingleton [_] = True
isSingleton _ = False
D - Bonfire
シグネチャを決める。
abc398d :: [Int] -- N,R,C
-> String -- S
-> String -- 答え
指示と逆の方向に原点と焚き火を動かす。
結果
import qualified Data.Set as S
import Data.Bool
abc398d :: [Int] -> String -> String
abc398d [_n, r, c] str = ans
where
(_, ans) = mapAccumL step (0,0,S.singleton (0,0)) str
step (ox,oy,s) 'N' = post (succ ox) oy s
step (ox,oy,s) 'E' = post ox (pred oy) s
step (ox,oy,s) 'W' = post ox (succ oy) s
step (ox,oy,s) 'S' = post (pred ox) oy s
post ox oy s = ((ox, oy, S.insert (ox,oy) s), if S.member (ox + r, oy + c) s then '1' else '0')
E - Tree Game
考える
番号1の頂点から、頂点を交互に白黒に塗り分ける。
こうすると、同じ色の頂点どうしを繋ぐと、奇閉路が発生する。
色が違う頂点どうし（で間に辺がないもの）を繋ぐと、偶閉路が完成する。さらに繋いでいっても問題は起きない。
なので、そのような辺が何本引けるかを考え、奇数なら先手、偶数なら後手を選び、
後は、まだ取られていないものを好きに選んでいけばよい。
Data.Setでする
対話形式だけど immutable に書きたいので、Data.Set だけでやってみる。
グラフは、$i$ $j$ 間に辺があるとき $(i,j)$ を持つ集合で表現する。
-- uvs :: [[Int]] -- Ui, Vi
g = S.fromList $ concat [[(u,v),(v,u)] | u:v:_ <- uvs]
このグラフを頂点1から再帰降下し交互に塗り分け、1と同じ色の頂点の集合を作る。
blacks = S.fromList $ recur 0 1 True
-- p:vの親 v:現在の頂点 b:黒 c:vの子
recur p v b = [v | b] ++ [vb | c <- [1 .. n], S.member (v,c) g, c /= p, vb <- recur v c (not b)]
張れる辺の集合を作る。色の違う頂点どうしで、g には辺がないもの。
ans = S.fromList
[ (i,j)
| i <- [1 .. pred n], j <- [succ i .. n]
, S.member i blacks /= S.member j blacks
, S.notMember (i,j) g]
ansの要素数が奇数なら先手、偶数なら後手を選び、
自分の番のとき最小要素を選んで返し、相手の手は自分のリストから削除する、
という対話プログラムを実装する。
結果
F - ABCBA
答えは S を接頭辞に持つので、答えの前半は S そのものになる。
回文を構成するような、残りの部分だけを返すことにして、シグネチャを決める。
import qualified Data.ByteString.Char8 as BS
abc398f :: BS.ByteString -- S
-> BS.ByteString -- 答え
32個もの after_contest が突っ込まれている。どんな嘘解答があったやら。
Manacher（直径奇数）
Manacherというアルゴリズムがあって、文字列の各位置からの最長の回文の長さを $O(|S|)$ で計算できるらしい。
わりとよくある備忘録 回文検出(Manacher)
のコードを参考にした。
配列をまりまり使うアルゴリズムかと身構えるが、よく見ると、ランダムアクセスが必要なのは入力文字列Sの各文字だけで、
過去の判定結果は（生成と逆順に）順次アクセスできればそれでよい。
元コードを読み解いていく。まず準備の部分：
string s = "abacababa"; // s : 入力文字列
int n = s.size(); // n : sの長さ
vector<int> rad(n); // rad[i] : 文字s[i]を中心とする回文の半径
int c = 0, r = 0; // c : s の各文字を中心にして順次計算するループ変数
// r : 調査する半径の開始値を伝える状態変数
シグネチャを決める。
manacher :: BS.ByteString -- s
-> [Int] -- 答え rad の内容
manacher s = ...
where
n1 = pred $ BS.length s -- nに相当
メインループは、forではないところが特徴的：
while (c < n) { // s[0]からs[n-1]まで順にrad[c]を求めていく
...
}
ループ内の前半では、中心に据えた文字の両側に同じ文字が並ぶ個数を数える。
最初に違う文字が出現した（あるいはsを踏み越えた）値が、中心の文字を含めた半径の大きさとなる。
// cを中心に同じ文字がどこまで連続するか
while (0 <= c - r && c + r < n && s[c - r] == s[c + r]) r++; // (A)
rad[c] = r; // (B)
これを関数に括り出す：
manacher s = spread [] 0 0
where
spread :: [Int] -- rs : rad[c-1,c-2,...,0] つまり求めたrad[]の内容の逆順、ここでは使わない
-> Int -- c : 現在の中心文字
-> Int -- r : カウント中の半径、インクリメントしていく
-> [Int] -- 答え ここでは rad[c] を求め、さらに続きのradも求めていく
spread rs c r
-- cがオーバーランしたら終了
| n1 < c = []
-- 左右r文字離れたところが同じなら広げる 上の(A)の処理
| 0 <= c - r, c + r <= n1, BS.index s (c - r) == BS.index s (c + r) = spread rs c (succ r)
-- 違う文字なら半径が求められた 上の(B)の処理
| otherwise = r : ...
ループ内の後半では、cを中心にr文字先まで、
手前側と半径が等しい（かそれ以上である）ことがついでに確定したので、その結果を流用する。
ただし、rに届いているときはそれ以上か調べ直す必要があるので、そこで止める。
//回文の長さに応じて利用可能な範囲を確認しつつメモ
int k = 1;
while (0 <= c - k && k + rad[c - k] < r) { // (C)
rad[c + k] = rad[c - k]; // (D)
k++;
}
これを関数に括り出す：
spread rs c r
| otherwise = r : mirror (r:rs) r (succ c) 1 rs
mirror :: [Int] -- rrs : rad[c-1,c-2,...,0] つまり求めたrad[]の内容の逆順、次のmirrorのために蓄積する
-> Int -- r0 : これを起動したspreadが求めたrの値
-> Int -- c0 : これを起動したspreadの中心文字
-> Int -- k : spreadから起動されてから何文字目かのカウント
-> [Int] -- rs : rad[c-1,c-2,...] 前から消費する
-> [Int] -- 答え ここでは rad[c0+k] を求め、さらに続きのradも求めていく
mirror rrs r0 c0 k (r:rs)
-- ガードは(C) 0 <= c0 - k は、引数rsが空でないことから保証される
-- 右辺は(D)
| k + r < r0 = r : mirror (r:rrs) r0 c0 (succ k) rs
ループの先頭に戻るときに、c が進められ、r は左側で数えた値から続けるように取り出される：
//すでに計算が終わった分だけ中心と探索半径をずらす
c += k;
r -= k;
これはmirrorからspreadへの呼び出しに写せる：
mirror rrs r0 c k _ = spread rrs (c0 + k) (r0 - k)
mirrorの変数kは、元のプログラムとの対比のため残したが、
毎回 c0をインクリメント、r0をデクリメントすれば不要になる：
（ただしspreadから呼び出す際のr0の初期値もpredしておく）
mirror rrs r0 c (r:rs)
| r < r0 = r : mirror (r:rrs) (pred r0) (succ c) rs
mirror rrs r0 c _ = spread rrs c r0
Manacher（偶数直径込み）
直径が偶数になる、文字の間を中心とする回文も調べるには、元文字列にダミー文字を挟み、
それらを中心とする回文は元の文字列では偶数直径の回文に相当する、とやればよい。
参考ページの続きにある方法では、文字列の文字の間だけでなく先頭と末尾にもダミーを追加している。
これは一見無駄に思えるが、ダミー文字vs文字列終端、という例外的な場合を排除できるので、
こうした方がロジックが簡潔になる、番兵のような効果がある。
spread mirror の内部ロジックは上の計算そのままで、
結果を出力する部分にのみ、ダミー文字込みの半径から直径に変換（といっても pred をとるだけ）
するロジックを追加する。
また、ダミー文字列を挟んだ文字列はメモリ中に構築せず、
文字列のアクセサに細工をして実現する。
manacher :: BS.ByteString -> [Int]
manacher s = tail $ spread [] 0 0 -- 先頭のダミー文字の結果を捨てる
where
n1 = 2 * BS.length s
a i | odd i = BS.index s (div i 2) -- 文字列アクセサ
| otherwise = '#'
spread rs c r
| c == n1 = [] -- 末尾のダミー文字について計算せずに終わらせる
| 0 <= c - r, c + r <= n1, a (c - r) == a (c + r) = spread rs c (succ r)
| otherwise = pred r : mirror (r:rs) (succ c) (pred r) rs
mirror rrs c r0 (r:rs)
| c == n1 = []
| r < r0 = pred r : mirror (r:rrs) (succ c) (pred r0) rs
mirror rrs c r0 _ = spread rrs c r0
問題への答え
問題の要求は、Sが abc-xyzyx のように末尾が回文になっているものの最長なものを求めて、
回文が始まる前の部分の反転 cba を作ることである。
manacher は、Sの各文字または文字と文字の間を中心とする回文の直径を順に返しているので、
その列の後ろから（1始まりで）第 k 要素が k であるものの最大値（はそのような先頭の値）を探し、
これを全長から引けば前半部の長さが得られる。
abc398f :: BS.ByteString -> BS.ByteString
abc398f s = BS.reverse $ BS.take k s
where
len = BS.length s
h = len + pred len
(rr,_) = head $ filter (uncurry (==)) $ zip [h, pred h .. 1] $ manacher s
k = len - rr
G - Not Only Tree Game
あとは頑張って考えるのだ……
あっこれ無理なやつです。