Submission #1519927


Source Code Expand

import Control.Arrow
import Data.List
import Data.Ord
import qualified Data.ByteString.Char8 as B
import qualified Data.IntSet as S
import qualified Data.Array.IArray as A

transField :: Field -> Field
transField = maximumBy (comparing evalField) . sequence [id, strategyPadding]

strategyPadding :: Field -> Field
strategyPadding f = maximumBy (comparing evalField) [padding Circle f, padding Cross f]

padding :: Block -> Field -> Field
padding b (Field h w blocks) = Field h w (map (pad b) blocks)

pad :: Block -> [Block] -> [Block]
pad b bs
  | nb >= nz = reverse (replicate (length ds) Plus ++ bs1)
  | otherwise = bs
  where
    (ds,bs1) = span (== Dot) (reverse bs)
    (nb,nz) = (length *** length) $ partition (== b) $ filter (/= Dot) bs

main :: IO ()
main = do
  ss <- lines <$> getContents
  let field = makeField ss
  print (transField field)
  --print $ evalField $ fallField $ transField field

type Height = Int
type Width= Int

data Block = Nil | Circle | Cross | Dot | Plus | Minus deriving Eq

instance Show Block where
  show Nil = " "
  show Circle = "o"
  show Cross = "x"
  show Dot = "."
  show Plus = "+"
  show Minus = "-"

data Field = Field {_h :: Int, _w :: Int, _blocks :: [[Block]]}

instance Show Field where
  show (Field _ _ bss) = unlines $ map (concatMap show) $ transpose $ bss

makeField :: [[Char]] -> Field
makeField ss = Field h w blocks
  where
    h = length ss
    w = length (head ss)
    blocks = map (map readBlock) (transpose ss)

type Index = Int
type Bound = (Vertex, Vertex)
type Vertex = Int
type Vertexes = S.IntSet
type Edge = (Vertex, Vertex)
type Graph = A.Array Vertex Vertexes

evalField :: Field -> Int
evalField field@(Field h _ _) = eval g1 + eval g2
  where
    bs = B.pack (show field)
    g1 = buildG (0, B.length bs) (readBitmap h (head (show Circle)) bs)
    g2 = buildG (0, B.length bs) (readBitmap h (head (show Cross)) bs)

eval :: Graph -> Int
eval g = maximum $ unfoldr (count g) (vertexes g)

count :: Graph -> Vertexes -> Maybe (Int, Vertexes)
count g vs
  | S.null vs = Nothing
  | otherwise = Just (S.size vs1, S.difference vs vs1)
  where
    vs1 = bfs g (S.findMin vs)

buildG :: Bound -> [Edge] -> Graph
buildG = A.accumArray (flip S.insert) S.empty

from :: Graph -> Vertex -> Vertexes
from = (A.!)

vertexes :: Graph -> Vertexes
vertexes = S.unions . A.elems

readBitmap :: Width -> Char -> B.ByteString -> [Edge]
readBitmap w c bs = foldr (scout w c bs) [] [i | i<-[0 .. B.length bs - 1], mod i (w+1) /= w, B.index bs i == c]

scout :: Width -> Char -> B.ByteString -> Index -> [Edge] -> [Edge]
scout w c bs i acc = zip (repeat i) neighbor ++ acc
  where
    neighbor = filter (\x -> inner x && movable x) [i - 1, i + 1, i - (w + 1), i + (w + 1)]
    inner x = x >= 0 && x < B.length bs
    movable x = B.index bs x == c

bfs :: Graph -> Vertex -> Vertexes
bfs g v = go (S.singleton v) (S.singleton v)
  where
    go acc border
      | S.null border = acc
      | otherwise = go (S.union acc next) next
        where
          next = S.difference (transMap g border) acc

transMap :: Graph -> Vertexes -> Vertexes
transMap g = S.unions . map (from g) . S.elems

readBlock :: Char -> Block
readBlock c = case c of
  'o' -> Circle
  'x' -> Cross
  '.' -> Dot
  '+' -> Plus
  '-' -> Minus
  _ -> error "readBlock"

fallField :: Field -> Field
fallField (Field h w blocks) = Field h w (map fall blocks)

fall :: [Block] -> [Block]
fall bs
  | null bs2 = f bs1
  | otherwise = f bs1 ++ [Minus] ++ fall (tail bs2)
  where
    (bs1, bs2) = break (== Minus) bs
    f = reverse . take (length bs1) . (++ repeat Nil) . reverse . filter (/= Dot)

Submission Info

Submission Time
Task A - ○×ブロック
User aimy
Language Haskell (GHC 7.10.3)
Score 1614
Code Size 3747 Byte
Status AC
Exec Time 6 ms
Memory 1532 KB

Judge Result

Set Name test_01 test_02 test_03 test_04 test_05 test_06 test_07 test_08 test_09 test_10
Score / Max Score 163 / 2500 213 / 2500 177 / 2500 111 / 2500 191 / 2500 122 / 2500 159 / 2500 138 / 2500 182 / 2500 158 / 2500
Status
AC × 1
AC × 1
AC × 1
AC × 1
AC × 1
AC × 1
AC × 1
AC × 1
AC × 1
AC × 1
Set Name Test Cases
test_01 subtask_01_01.txt
test_02 subtask_01_02.txt
test_03 subtask_01_03.txt
test_04 subtask_01_04.txt
test_05 subtask_01_05.txt
test_06 subtask_01_06.txt
test_07 subtask_01_07.txt
test_08 subtask_01_08.txt
test_09 subtask_01_09.txt
test_10 subtask_01_10.txt
Case Name Status Exec Time Memory
subtask_01_01.txt AC 6 ms 1404 KB
subtask_01_02.txt AC 6 ms 1404 KB
subtask_01_03.txt AC 6 ms 1532 KB
subtask_01_04.txt AC 6 ms 1404 KB
subtask_01_05.txt AC 6 ms 1532 KB
subtask_01_06.txt AC 6 ms 1404 KB
subtask_01_07.txt AC 6 ms 1404 KB
subtask_01_08.txt AC 6 ms 1404 KB
subtask_01_09.txt AC 6 ms 1404 KB
subtask_01_10.txt AC 6 ms 1404 KB