AtCoder Regular Contest 031

HaskellでAtCoderを解説する記事が望まれているらしい…？

A - 名前

入力された文字列が回文かどうか判定するだけの問題。
Haskellだと s == reverse s で判定できますね。

a.hs

main :: IO ()
main = do
  s <- getLine
  putStrLn $ if s == reverse s then "YES" else "NO"

B - 埋め立て

10×10のサイズの2次元の地図が与えられるので、1つ陸地を追加して、1つの島にできるかどうかを判定する問題。

サイズが小さいので、埋め立てる座標を全部試せば良いですね。1つの島になっているかどうかは、その埋め立てた座標から塗りつぶして、すべての陸地に到達できればOK。

まず入力ですが、10行と決まっているので、

bs <- replicateM 10 getLine

と replicateM を使うのが便利です。これで10個の文字列からなるリストが帰ってきます。

あとは2次元の配列を塗りつぶしながら探索するのですが、Haskellではこういうmutableなアルゴリズムを書くのがとても面倒くさい！AtCoderではmutableな配列を扱う標準的なライブラリとして、vectorとarrayが使えますが、vectorは2次元配列がものすごく扱いづらいという問題があって、arrayは表現力に乏しいという問題があります。今回は2次元配列を扱いますので、我慢してarrayを使いました。

arrayライブラリを使ったコードでは、2次元リストを2次元配列に変換するには、

listArray ((0, 0), (9, 9)) $ concat bs

こういうダサい感じのコードになると思います。これで得られるのはimmutableな配列なので、これをmutableな配列に変換するために thaw を使います。

(m :: IOUArray (Int, Int) Char)  <-
          thaw $ listArray ((0, 0), (9, 9)) $ concat bs

mutableな配列はIOとかSTとかいろいろオーバーロードされているので、型を明示してやらなければいけないことが多くて、今回もそれで怒られたので、バインドの左側に型を明示的に書いています。束縛の方に型アノテーションを書く場合、ちょっと面倒くさくて、 {-# LANGUAGE ScopedTypeVariables #-} が必要になります。非常にめんどくさいですね。この拡張を使わなければ、右側にアノテーションを付けて、

m <- thaw $ listArray ((0, 0), (9, 9)) $ concat bs :: IO (IOUArray (Int, Int) Char)

こう書いても良いのですが、本来書きたいわけではない IO を書いているので、どうにも冗長な気がします。どっちにしろカッコ悪いですね。

あとは再帰で塗りつぶし関数を書いて、終わりです。

f cx cy m
  | cx >= 0 && cx < 10 && cy >= 0 && cy < 10 = do
    b <- readArray m (cx, cy)
    unless (b == 'x') $ do
      writeArray m (cx, cy) 'x'
      f (cx + 1) cy m
      f (cx - 1) cy m
      f cx (cy + 1) m
      f cx (cy - 1) m
  | otherwise =
      return ()

最初に境界チェックをして、それから配列にアクセスして、中身が 'x' じゃないかチェックして、とやっているのですが、C++だとこういう判定を

if (cx >= 0 && cx < 10 && cy >= 0 && cy < 10 && m[cy][cx] != 'x') {
  ...
}

とまとめて書けるところが、Haskellだと境界チェックがPureな操作で、配列の中身チェックがImpureな操作になるので、2箇所で判定しています。イマイチ良くないと思うのでなんとかならないものでしょうか。

あと些末な点ですが、添字を (x, y) にしたので、メモリへの格納のされ方がX座標に対して連続になっていると思います。今回はサイズが小さいので、あまり気にしていません。

b.hs

{-# LANGUAGE ScopedTypeVariables #-}

import           Control.Applicative
import           Control.Monad
import           Data.Array
import           Data.Array.IO

main :: IO ()
main = do
  bs <- replicateM 10 getLine

  let check :: Int -> Int -> IO Bool
      check x y = do
        (m :: IOUArray (Int, Int) Char)  <-
          thaw $ listArray ((0, 0), (9, 9)) $ concat bs
        writeArray m (x, y) 'o'
        f x y m
        r <- freeze m
        return $ all (== 'x') $ elems r

      f cx cy m
        | cx >= 0 && cx < 10 && cy >= 0 && cy < 10 = do
          b <- readArray m (cx, cy)
          unless (b == 'x') $ do
            writeArray m (cx, cy) 'x'
            f (cx + 1) cy m
            f (cx - 1) cy m
            f cx (cy + 1) m
            f cx (cy - 1) m
        | otherwise =
          return ()

  r <- forM [0..9] $ \y ->
    forM [0..9] $ \x ->
      check x y

  putStrLn $ if any or r then "YES" else "NO"

C - 積み木

小さい要素から両端に捨てていくというアルゴリズムです。

まず入力ですが、今回は非常に要素数が多いので、ByteString を使って入力します。

n :: Int <- readLn
bs :: [Int] <- map (fst . fromJust . B.readInt) . B.words <$> B.getLine

ByteString を単語に分解して、それからそれぞれを整数に変換しています。ByteStringを整数に変換するには readInt 関数が使えますが、これは失敗に対応するために Maybe (Int, ByteString) を返すので、 fst . fromJust で失敗を無視しています。

次に入力したデータに、添字をつけてソートします。

let ord = sort $ zip bs [0..]

こういう処理はHaskellだと非常に楽ですね。

あとはこれの添え字を順に消していきます。

go ((_, ix): rs) !reft !acc =
  let (!l, _, !r) = S.splitMember ix reft
  in go rs (S.delete ix reft) $ acc + min (S.size l) (S.size r)

普通に再帰で繰り返しを書いています。10^5個要素があるので、!がないと多分スタックが溢れます。

Data.Set.splitMember を使うと、Setを、指定した値より大きいものと小さいものの2つに分割できます。この操作は O(logn) で完了します。小さいものが、各要素よりも左にあるものの個数、大きい物が右にあるものの個数に対応しているので、これのminをとって足し上げていけば、求める解が得られます。

これはHaskell向きな問題でしたね（なおData.Setの代わりにData.IntSetを使うとTLEする模様）。

c.hs

{-# LANGUAGE BangPatterns        #-}
{-# LANGUAGE ScopedTypeVariables #-}

import           Control.Applicative
import qualified Data.ByteString.Char8 as B
import           Data.List
import           Data.Maybe
import qualified Data.Set              as S

main :: IO ()
main = do
  n :: Int <- readLn
  bs :: [Int] <- map (fst . fromJust . B.readInt) . B.words <$> B.getLine

  let ord = sort $ zip bs [0..]

      go [] _ acc = acc
      go ((_, ix): rs) !reft !acc =
        let (!l, _, !r) = S.splitMember ix reft
        in go rs (S.delete ix reft) $ acc + min (S.size l) (S.size r)

  print $ go ord (S.fromList [0..n-1]) 0

D - 買い物上手

わからなかったので、部分点解法のみ。

部分点を取るにはどのセットの経験値をゲットするのか全通り試せばOKです（2^10通り）。

generate & test を実装するには、リストモナドを使うととっても綺麗に書けます。

let ans = maximum $ do
      ...

ここに解の候補を書いていきます。まず、どの経験値パックを取得するのか、n要素のTrue/Falseの組み合わせを全通り生成しますが、これは [True, False] の2択をn回やるわけなので、replicateM が使えます。

sel <- replicateM n [True, False]

次にどのアイテムを買わなければいけないのか求めます。

buy = nub $ concat [ a | (True, a) <- zip sel as ]

zipしてTrueに対応するものだけ取り出して、それの和集合を求めます。今回は速度を考えないので、concatしてnubしました。

あとは必要な金額を求めて、

pay = sum $ map (\i -> ts !! (i-1)) buy

得られる経験値を求めて、

exp = sum [ s | (True, s) <- zip sel ss ]

効率を求めて返します。

return $ fromIntegral exp / fromIntegral pay

Doubleの値を表示するにはやっぱりprintfを使うと楽です。

printf "%.12f\n" (ans :: Double)

d.hs

import           Control.Applicative
import           Control.Monad
import           Data.List
import           Text.Printf

getInts :: IO [Int]
getInts = map read . words <$> getLine

main :: IO ()
main = do
  [n, m] <- getInts

  ss <- getInts
  ts <- getInts

  as <- replicateM n $ do
    (_k: a) <- getInts
    return a

  let ans = maximum $ do
        sel <- replicateM n [True, False]
        let buy = nub $ concat [ a | (True, a) <- zip sel as ]
            pay = sum $ map (\i -> ts !! (i-1)) buy
            exp = sum [ s | (True, s) <- zip sel ss ]
        return $ fromIntegral exp / fromIntegral pay

  printf "%.12f\n" (ans :: Double)