1 {-# LANGUAGE OverloadedStrings #-}
5 import Data.Text (Text)
6 import qualified Data.Text.IO as TIO
8 import Data.Void (Void)
10 import Text.Megaparsec
11 import Text.Megaparsec.Char
12 import qualified Text.Megaparsec.Char.Lexer as L
13 import qualified Control.Applicative as CA
15 import qualified Data.Map.Strict as M
17 type Coord = (Integer, Integer) -- x, y
18 type Bounds = (Integer, Integer, Integer, Integer) -- minX, maxX, minY, maxY
19 type Region = M.Map Coord Int
23 text <- TIO.readFile "data/advent06.txt"
24 let coords = successfulParse text
25 let boundingBox = findBounds coords
28 print $ part1 coords boundingBox
29 print $ part2 coords boundingBox
32 part1 coords bounds = largestRegion $ regionSizes $ finite edgeLabels regions
33 where regions = findRegions coords bounds
34 edgeLabels = infinite regions bounds
36 part2 coords bounds = M.size $ M.filter (< 10000) $ safeCells coords bounds
38 findRegions :: [Coord] -> Bounds -> Region
39 findRegions coords (minX, maxX, minY, maxY) = M.fromList labelledCells
40 where cells = [(x, y) | x <- [minX .. maxX], y <- [minY .. maxY] ]
41 starts = zip [1..] coords
42 labelledCells = map (\c -> (c, nearestStart 0 c starts)) cells
44 nearestStart :: Int -> Coord -> [(Int, Coord)] -> Int
45 nearestStart tieLabel cell starts = nearestLabel
46 where distances = sort $ map (\(l, s) -> (distance s cell , l)) starts
47 nearestLabel = if fst (distances!!0) == fst (distances!!1)
49 else snd (distances!!0)
52 safeCells :: [Coord] -> Bounds -> Region
53 safeCells coords (minX, maxX, minY, maxY) = M.fromList distanceCells
54 where cells = [(x, y) | x <- [minX .. maxX], y <- [minY .. maxY] ]
55 distanceCells = map (\c -> (c, fromIntegral $ sumDistance c coords) ) cells
58 sumDistance :: Coord -> [Coord] -> Integer
59 sumDistance here others = sum $ map (\c -> distance here c) others
62 infinite :: Region -> Bounds -> [Int]
63 infinite regions (minX, maxX, minY, maxY) = nub $ sort $ M.elems $ M.filterWithKey onEdge regions
64 where onEdge (x, y) _ = (x == minX) || (x == maxX) || (y == minY) || (y == maxY)
66 finite :: [Int] -> Region -> Region
67 finite excluded regions = M.filter (\r -> r `notElem` excludedTied) regions
68 where excludedTied = (0:excluded)
71 regionSizes :: Region -> [(Int, Int)]
72 regionSizes regions = map (\g -> (g!!0, length g)) $ group $ sort $ M.elems regions
75 largestRegion :: [(Int, Int)] -> Int
76 largestRegion = maximum . map snd
79 findBounds :: [Coord] -> (Integer, Integer, Integer, Integer)
80 findBounds coords = ( minX - (maxY - minY) -- small x edge
81 , maxX + (maxY - minY) -- large x edge
82 , minY - (maxX - minX) -- small x edge
83 , maxY + (maxX - minX) -- large y edge
85 where maxX = maximum $ map fst coords
86 minX = minimum $ map fst coords
87 maxY = maximum $ map snd coords
88 minY = minimum $ map snd coords
91 distance :: Coord -> Coord -> Integer
92 distance (x1, y1) (x2, y2) = (abs (x1 - x2)) + (abs (y1 - y2))
95 -- Parse the input file
97 type Parser = Parsec Void Text
100 sc = L.space (skipSome spaceChar) CA.empty CA.empty
101 -- sc = L.space (skipSome (char ' ')) CA.empty CA.empty
104 integer = lexeme L.decimal
110 coordFileP = many coordP
111 coordP = (,) <$> integer <* commaP <*> integer
113 successfulParse :: Text -> [Coord]
114 successfulParse input =
115 case parse coordFileP "input" input of
116 Left _error -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err
117 Right coords -> coords