module Commons where import GHC.IO.Handle (isEOF) import Data.Map (Map, assocs, member, (!), fromList) data Direction = North | East | West | South deriving (Eq, Show) data Hole = Hole { direction :: Direction, size :: Int } deriving (Eq, Show) type Grid = Map (Int, Int) Hole getAllLines :: IO [String] getAllLines = do done <- isEOF if done then return [] else do line <- getLine otherLines <- getAllLines return $ line: otherLines parseInstruction :: (Int, Int) -> Direction -> Int -> ((Int, Int), Hole) parseInstruction (y, x) South n = ((y + 1, x), Hole {direction = South, size = n - 1}) parseInstruction (y, x) East n = ((y, x + 1), Hole {direction = East, size = n - 1}) parseInstruction (y, x) North n = ((y - 1, x), Hole {direction = North, size = n - 1}) parseInstruction (y, x) West n = ((y, x - 1), Hole {direction = West, size = n - 1}) parseGrid :: ((Int, Int) -> String -> ((Int, Int), Hole)) -> [String] -> [((Int, Int), Hole)] -> Grid parseGrid _ [] otherTiles = fromList otherTiles parseGrid parseLine (line: t) otherTiles = if null otherTiles then parseGrid parseLine t [parseLine (1, 1) line] else let ((y, x), lastHole) = last otherTiles newStart = case direction lastHole of North -> (y - size lastHole, x) East -> (y, x + size lastHole) South -> (y + size lastHole, x) West -> (y, x - size lastHole) tiles = parseLine newStart line in parseGrid parseLine t (otherTiles ++ [tiles]) getBounds :: [((Int, Int), Hole)] -> ((Int, Int), (Int, Int)) -> ((Int, Int), (Int, Int)) getBounds [] coords = coords getBounds (((y, x), h): t) ((yMin, xMin), (yMax, xMax)) | y < yMin = getBounds (((y, x), h): t) ((y, xMin), (yMax, xMax)) | x < xMin = getBounds (((y, x), h): t) ((yMin, x), (yMax, xMax)) | y > yMax = getBounds (((y, x), h): t) ((yMin, xMin), (y, xMax)) | x > xMax = getBounds (((y, x), h): t) ((yMin, xMin), (yMax, x)) | otherwise = getBounds t ((yMin, xMin), (yMax, xMax)) getAreaToStart :: (Int, Int) -> Int -> Hole -> Grid -> Bool -> Int getAreaToStart (1, 2) _ _ _ True = 0 getAreaToStart (1, 0) _ _ _ True = 0 getAreaToStart (2, 1) _ _ _ True = 0 getAreaToStart (0, 1) _ _ _ True = 0 getAreaToStart (y, x) xMax h grid _ | direction h == South = let (newY, newX) = (y + size h, x) in size h * (xMax - x) + if member (newY, newX + 1) grid then getAreaToStart (newY, newX + 1) xMax (grid ! (newY, newX + 1)) grid True else xMax - x + getAreaToStart (newY, newX - 1) xMax (grid ! (newY, newX - 1)) grid True getAreaToStart (y, x) xMax h grid _ | direction h == West = let (newY, newX) = (y, x - size h) in if member (newY - 1, newX) grid then newX - xMax - 1 + getAreaToStart (newY - 1, newX) xMax (grid ! (newY - 1, newX)) grid True else getAreaToStart (newY + 1, newX) xMax (grid ! (newY + 1, newX)) grid True getAreaToStart (y, x) xMax h grid _ | direction h == North = let (newY, newX) = (y - size h, x) in size h * (x - xMax - 1) + if member (newY, newX + 1) grid then x - xMax - 1 + getAreaToStart (newY, newX + 1) xMax (grid ! (newY, newX + 1)) grid True else getAreaToStart (newY, newX - 1) xMax (grid ! (newY, newX - 1)) grid True getAreaToStart (y, x) xMax h grid _ | direction h == East = let (newY, newX) = (y, x + size h) in if member (newY - 1, newX) grid then getAreaToStart (newY - 1, newX) xMax (grid ! (newY - 1, newX)) grid True else xMax - newX + getAreaToStart (newY + 1, newX) xMax (grid ! (newY + 1, newX)) grid True getInnerArea :: Grid -> Int getInnerArea grid = let ((yMin, xMin), (yMax, xMax)) = getBounds (assocs grid) ((maxBound, maxBound), (minBound, minBound)) in if member (2, 1) grid then getAreaToStart (2, 1) xMax (grid ! (2, 1)) grid False else if member (1, 2) grid then getAreaToStart (1, 2) xMax (grid ! (1, 2)) grid False else if member (1, 0) grid then getAreaToStart (1, 0) xMax (grid ! (1, 0)) grid False else getAreaToStart (0, 1) xMax (grid ! (0, 1)) grid False getPerimeter :: Grid -> Int getPerimeter = foldr (\ (_, t) -> (+) (size t + 1)) 0 . assocs getArea :: Grid -> Int getArea grid = let innerArea = getInnerArea grid in if innerArea < 0 then abs innerArea else innerArea + getPerimeter grid