Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- module Main where
- import Control.Arrow
- import Data.Array
- import Data.Char
- import Data.Bits
- import Data.Function
- import Data.List
- import Data.Maybe
- type Bark = Array (Int, Int) Bool
- main = do
- barks <- readBarks
- print $ map solve barks
- readBarks :: IO [Bark]
- readBarks = do
- s <- getContents
- return (parseBarks s)
- parseBarks :: String -> [Bark]
- parseBarks s =
- let _ : rest = lines s
- parse (mn:s) =
- let [m, n] = map read $ words mn
- (ls, rs) = splitAt m s
- parseBits = take n . concatMap toBits
- in (listArray ((0,0), (m-1, n-1)) (concatMap parseBits ls), rs)
- in chop parse rest
- toBits c = [ testBit x i | i <- [3,2,1,0]]
- where x = digitToInt c
- type BarkSize = Array (Int,Int) Int
- printBarkSize x = putStrLn $ unlines $ map show $
- blockBy (snd (snd $ bounds x) + 1) $ elems x
- barkSizes :: Bark -> BarkSize
- barkSizes bark = res
- where
- res = mapWithIndex f bark
- (ur,uc) = snd $ bounds bark
- f (r,c) me | r == ur || c == uc = 1
- | not $ all (== me) check = 1
- | otherwise = minimum [down,right,downRight] + 1
- where
- check = [bark ! (r+1,c+1), not $ bark ! (r+1,c), not $ bark ! (r,c+1)]
- down = res ! (r+1,c)
- right = res ! (r,c+1)
- downRight = res ! (r+1,c+1)
- cutBiggest :: BarkSize -> Maybe (Int, BarkSize)
- cutBiggest x | n == 0 = Nothing
- | otherwise = Just (n, cutBark p n x)
- where (p,n) = findBiggest x
- findBiggest = maximumBy (compare `on` snd) . reverse . assocs
- cutBark :: (Int,Int) -> Int -> BarkSize -> BarkSize
- cutBark (r,c) n = mapWithIndex f
- where f (r',c') x | inRange ((r,c),(r+n-1,c+n-1)) (r',c') = 0
- | otherwise = min dist x
- where dist = min (g $ r-r') (g $ c-c')
- g i = if i <= 0 then maxBound else i
- mapWithIndex :: Ix i => (i -> a -> b) -> Array i a -> Array i b
- mapWithIndex f a = listArray (bounds a) . map (uncurry f) . assocs $ a
- chop :: ([a] -> (b, [a])) -> [a] -> [b]
- chop _ [] = []
- chop f xs = y : chop f xs'
- where (y, xs') = f xs
- blockBy :: Int -> [a] -> [[a]]
- blockBy n = chop (splitAt n)
- solve = map (head &&& length) . group . unfoldr cutBiggest . barkSizes
Add Comment
Please, Sign In to add comment