ABC287 A～E をHaskellで

前回の286といい今回の287といい、ノスタルジックな数字。
まだそのころ自分はMac使いでしたが。縦型モノクロ15インチモニタ装備のIIsiに、OASYSから強奪したキーボードでカタカタしていた。

A - Majority

問題 ABC287A

過半数ということは、Forの個数を倍にしたとき $N$ を超えるはず。

結果

main = do
  n <- readLn
  ss <- lines <$> getContents
  let yes = n < 2 * length (filter ("For" ==) ss)
  putStrLn $ if yes then "Yes" else "No"

B - Postal Card

問題 ABC287B

シグネチャを決める。

abc287b :: Int       -- N
        -> Int       -- M
        -> [String]  -- Si
        -> [String]  -- Ti
        -> Int       -- 答え

単純に2重ループを回して一致を数えると、 例3のように $T_i$ 側に重複がある場合に数えすぎてしまう。

import Data.List

abc287b n m ss ts = length  -- 注意：まちがい
  [ ()
  | s <- ss
  , t <- ts
  , isSuffixOf t s
  ]

$T_i$ に接尾辞になるものが一つはあるか、を調べる。

import Data.List

abc287b n m ss ts = length
  [ ()
  | s <- ss
  , or [isSuffixOf t s | t <- ts]
--  , any (flip isSuffixOf s) ts    -- 別の書き方
  ]

結果

$S_i$ の長さも固定、また数字のみと限定されているので、IntSet を利用すると速くなるはず。
（この問題でそこまで頑張る必要はないが。）

import qualified Data.IntSet as IS

abc287b n m ss ts = length [() | s <- ss, IS.member (read $ drop 3 s) tS]
  where
    tS = IS.fromList $ map read ts

C - Path Graph?

問題 ABC287C

シグネチャを決める。

abc287c :: Int          -- N
        -> Int          -- M
        -> [(Int,Int)]  -- ui, vi
        -> Bool         -- 答え

頂点の次数（接続している辺の本数）を全て数えて、両端が1、その他すべてが2になっていればよい？
と甘いことを考えたら、例1（パスグラフ）と例3（輪っか）が同居するグラフで引っかかった。

辺の本数が頂点の数-1で、全てが連結になっているかをUnion-Findで調べたらいいのかな？といつものように考えたら、それは単に木かどうかの判定でしかなかった。パスグラフは木だが、パスグラフでない木もあるので間違い。ただし、コンテスト中はこの嘘解答で通ってしまったようで、after_contestが追加されていた。

きちんと辺を把握し、パスグラフの両端を見つけ、一本道で辿れることを愚直に確認するアプローチをとる。

結果

gr は、いつもの辺リストを持つ配列。
sg は、辺リストが1要素な頂点のリスト。2要素であることが必要。
loop で s から始めて g に分岐なしで到達できるか辿って確かめる。
引数は順に、辿るべき辺の残り本数、1つ前のノード、現在のノード。1つ前のノードは、逆行しないために必要ないつもの引数。

import Data.Array

abc287c :: Int -> Int -> [(Int,int)] -> Bool
abc287c n m uvs = n == succ m && length sg == 2 && valid
  where
    gr = accumArray (flip (:)) [] (1,n) [p | (u:v:_) <- uvs, p <- [(u,v),(v,u)]]
    sg = [u | (u,[_]) <- assocs gr]
    [s,g] = sg
    valid = loop (pred n) 0 s
    
    loop 0 _ u = u == g
    loop k p u =
      case filter (p /=) $ gr ! u of
        [v] -> loop (pred k) u v
        _ -> False

追記

頂点の次数について確認し、かつ、全てが連結かどうかも調べれば、正解できるようだ。

D - Match or Not

問題 ABC287D

シグネチャを決める。

abc287d :: String  -- S
        -> String  -- T
        -> Bool    -- 答え

$x + y = |T|$ とする。
$S$ の前 $x$ 文字が $T$ のそれとマッチし、かつ、$S$ の後ろ $y$ 文字が $T$ のそれとマッチするなら、$x$ については Yes である。
前半と後半はそれぞれ、両サイドから累積して求められる。

結果

いかにもHaskellといった感じになったと思う。

abc287d s t = zipWith (&&) ls rs
  where
    ls = scanl (&&) True $ zipWith match1 s t
    rs = scanr (&&) True $ zipWith match1 (drop d s) t
    d = length s - length t

-- 1文字どうしがマッチするか
match1 '?' _ = True
match1 _ '?' = True
match1 a b = a == b

E - Karuta

問題 ABC287E

シグネチャを決める。

abc287e :: Int       -- N
        -> [String]  -- Si
        -> [Int]     -- 答え

何だかややこしい問題文だが、ともかく全ての $S_i$ それぞれについて、それ以外の $S_j$ と突き合わせて、先頭から一致する文字数が最大でいくつになるのかを調べろ、ということのようだ。

百人一首の「決まり字」がそれぞれの句についてどうなるのか、という計算か。

全ての $S_j$ について調べなくとも、辞書順にソートすれば、前後の句とだけ比較すれば済む。それより離れた句は手前のもの以上に違いがあるはず。

結果

ソートしてしまうとそれが何番の句だったかわからなくなるので、番号を付与しておき、後で集めるという、微妙に泥臭い計算をすることになる。

import Data.Array

abc287e n ss =
  where
    sss = sort $ zip ss [1..]  -- 背番号を付けておいてソート
    arr = accumArray max 0 (1,n) $
          concat
          [ [(i,l), (j,l)]                       -- 3. lはSiとSjの結果の候補となる
          | ((s,i),(t,j)) <- zip sss (tail sss)  -- 1. ソートして隣接したSi,Sjについて
          , let l = lcp s t                      -- 2. LCP(Si,Sj) を求めると、
          ]

lcp :: String -> String -> Int
lcp s1 s2 = length $ takeWhile id $ zipWith (==) s1 s2

実際にはデータ量が多いので ByteString を用いたが、Data.ByteString.zipWith があったのでコードはほぼ同一である。