AtCoder Regular Contest 040

A - 床塗

'R' と 'C' を数えるだけ。

import Data.Functor ((<$>))

main :: IO ()
main = putStrLn =<< solve <$> (concat <$> tail <$> lines <$> getContents)

solve :: String -> String
solve xs = case length (filter (=='R') xs) `compare` length (filter (=='B') xs) of
  GT -> "TAKAHASHI"
  LT -> "AOKI"
  _ -> "DRAW"

B - 直線塗り

'.' にぶつかったら r 個塗るだけ。最初、ペンキが 'o' にぶつかったらそれ以上は塗られないと思ってたけど違った。提出する前に気がついてよかった。

import Control.Applicative ((<$>), (<*>))

main :: IO ()
main = print =<< solve <$> ((!!1) <$> map read <$> words <$> getLine) <*> getLine

solve :: Int -> String -> Int
solve _ [] = 0
solve r ('o':s) | all (=='o') s = 0
                | all (=='o') $ drop (r - 1) s = 1
                | otherwise = 1 + solve r s
solve r s = 1 + solve r (replicate r 'o' ++ drop r s)

C - Z塗り

最初は全ての (r, c) に対して塗れる数が一番多いやつを選んで…ってやってたけど、TLE/WAしてしまった。よく考えてみると、各行に対して貪欲に調べていくだけでよかった。ある行を全て塗り、かつ次の行もいっぱい塗れるような c を見つけて塗る。そういうふうにして各行に対して塗っていくだけ。

import Data.Functor ((<$>))

main :: IO ()
main = print =<< solve <$> (tail <$> lines <$> getContents)

solve :: [String] -> Int
solve [] = 0
solve xxs@(x:xs) | all (=='o') x = solve xs
                 | otherwise = 1 + solve (paint 0 (last [ i | (i, c) <- zip [0..] x, c /= 'o' ]) xxs)

paint :: Int -> Int -> [String] -> [String]
paint r c xss = [ [ paintOne r c i j x | (j, x) <- zip [0..] xs ] | (i, xs) <- zip [0..] xss ]

paintOne :: Int -> Int -> Int -> Int -> Char -> Char
paintOne r c i j x = if i == r && j <= c || i == r + 1 && j >= c then 'o' else x

jasyさんの解答が美しかった。foldl' で簡単に解けるんだなぁ。ミソは take b ってところかな。うーん、この解法は気が付かなかった。

import Control.Applicative ((<$>), (<*>))
import Data.List (elemIndices, foldl')
import Data.Maybe (fromMaybe, listToMaybe)

main :: IO ()
main = print =<< solve <$> readLn <*> (lines <$> getContents)

solve :: Int -> [String] -> Int
solve n = fst . foldl' (\(a, b) xs -> (a + fromEnum (any (/='o') $ take b xs), fromMaybe n $ listToMaybe $ reverse $ elemIndices '.' $ take b xs)) (0, n)

D - カクカク塗り

わからんぽん。