Submission #1520040
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 = maximum . sequence [id, strategyPadding] strategyPadding :: Field -> Field strategyPadding f = max (padding Circle f) (padding Cross f) padding :: Block -> Field -> Field padding b (Field h w blocks s) = Field h w falled (evalField h falled) where falled = 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 $ fallField $ field print $ (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]], _score :: Int } deriving Eq instance Ord Field where (Field _ _ _ s1) <= (Field _ _ _ s2) = s1 <= s2 instance Show Field where show (Field _ _ bss _) = unlines $ map (concatMap show) $ transpose bss makeField :: [[Char]] -> Field makeField ss = Field h w blocks (evalField h blocks) where h = length ss w = length (head ss) blocks = map (map readBlock) (transpose ss) evalField :: Height -> [[Block]] -> Int evalField h blocks = eval g1 + eval g2 where bs = B.pack $ show $ fallField (Field undefined undefined blocks undefined) g1 = buildG (0, B.length bs - 1) (readBitmap h (head (show Circle)) bs) g2 = buildG (0, B.length bs - 1) (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) type Index = Int type Bound = (Vertex, Vertex) type Vertex = Int type Vertexes = S.IntSet type Edge = (Vertex, Vertex) type Graph = A.Array Vertex Vertexes 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 falled (evalField h falled) where falled = 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 | 1963 |
Code Size | 3983 Byte |
Status | AC |
Exec Time | 7 ms |
Memory | 2172 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 | 165 / 2500 | 255 / 2500 | 276 / 2500 | 114 / 2500 | 233 / 2500 | 165 / 2500 | 159 / 2500 | 142 / 2500 | 182 / 2500 | 272 / 2500 | ||||||||||||||||||||
Status |
|
|
|
|
|
|
|
|
|
|
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 | 7 ms | 2044 KB |
subtask_01_02.txt | AC | 7 ms | 2044 KB |
subtask_01_03.txt | AC | 7 ms | 1916 KB |
subtask_01_04.txt | AC | 7 ms | 2172 KB |
subtask_01_05.txt | AC | 7 ms | 1916 KB |
subtask_01_06.txt | AC | 7 ms | 2172 KB |
subtask_01_07.txt | AC | 7 ms | 2172 KB |
subtask_01_08.txt | AC | 7 ms | 2172 KB |
subtask_01_09.txt | AC | 7 ms | 2172 KB |
subtask_01_10.txt | AC | 7 ms | 2044 KB |