src/advent06/advent06.hs

   1 {-# LANGUAGE OverloadedStrings #-}
   2
   3 import Data.List
   4
   5 import Data.Text (Text)
   6 import qualified Data.Text.IO as TIO
   7
   8 import Data.Void (Void)
   9
  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
  14
  15 import qualified Data.Map.Strict as M
  16
  17 type Coord = (Integer, Integer) -- x, y
  18 type Bounds = (Integer, Integer, Integer, Integer)
  19 type Region = M.Map Coord Int
  20
  21 main :: IO ()
  22 main = do
  23         text <- TIO.readFile "data/advent06.txt"
  24         let coords = successfulParse text
  25         let boundingBox = findBounds coords
  26         print $ length coords
  27         print boundingBox
  28         print $ part1 coords boundingBox
  29         print $ part2 coords boundingBox
  30         -- print $ part1 activity
  31         -- print $ part2 activity
  32
  33
  34 part1 coords bounds = largestRegion $ regionSizes $ finite edgeLabels regions
  35     where regions = findRegions coords bounds
  36           edgeLabels = infinite regions bounds
  37
  38 part2 coords bounds = M.size $ M.filter (< 10000) $ safeCells coords bounds
  39
  40 findRegions :: [Coord] -> Bounds -> Region
  41 findRegions coords (minX, maxX, minY, maxY) = M.fromList labelledCells
  42     where cells = [(x, y) | x <- [minX .. maxX], y <- [minY .. maxY] ]
  43           starts = zip [1..] coords
  44           labelledCells = map (\c -> (c, nearestStart 0 c starts)) cells
  45
  46 nearestStart :: Int -> Coord -> [(Int, Coord)] -> Int
  47 nearestStart tieLabel cell starts = nearestLabel
  48     where distances = sort $ map (\(l, s) -> (distance s cell , l)) starts
  49           nearestLabel = if fst (distances!!0) == fst (distances!!1)
  50                          then tieLabel
  51                          else snd (distances!!0)
  52
  53
  54 safeCells :: [Coord] -> Bounds -> Region
  55 safeCells coords (minX, maxX, minY, maxY) = M.fromList distanceCells
  56     where cells = [(x, y) | x <- [minX .. maxX], y <- [minY .. maxY] ]
  57           distanceCells = map (\c -> (c, fromIntegral $ sumDistance c coords) ) cells
  58
  59
  60 sumDistance :: Coord -> [Coord] -> Integer
  61 sumDistance here others = sum $ map (\c -> distance here c) others
  62
  63
  64 infinite :: Region -> Bounds -> [Int]
  65 infinite regions (minX, maxX, minY, maxY) = nub $ sort $ M.elems $ M.filterWithKey onEdge regions
  66     where onEdge (x, y) _ = (x == minX) || (x == maxX) || (y == minY) || (y == maxY)
  67
  68 finite :: [Int] -> Region -> Region
  69 finite excluded regions = M.filter (\r -> r `notElem` excludedTied) regions
  70     where excludedTied = (0:excluded)
  71
  72
  73 regionSizes :: Region -> [(Int, Int)]
  74 regionSizes regions = map (\g -> (g!!0, length g)) $ group $ sort $ M.elems regions
  75
  76
  77 largestRegion :: [(Int, Int)] -> Int
  78 largestRegion = maximum . map snd
  79
  80
  81 findBounds :: [Coord] -> (Integer, Integer, Integer, Integer)
  82 findBounds coords = ( minX - (maxY - minY) -- small x edge
  83                     , maxX + (maxY - minY) -- large x edge
  84                     , minY - (maxX - minX) -- small x edge
  85                     , maxY + (maxX - minX) -- large y edge
  86                     )
  87     where maxX = maximum $ map fst coords
  88           minX = minimum $ map fst coords
  89           maxY = maximum $ map snd coords
  90           minY = minimum $ map snd coords
  91
  92 -- Manhattan distance
  93 distance :: Coord -> Coord -> Integer
  94 distance (x1, y1) (x2, y2) = (abs (x1 - x2)) + (abs (y1 - y2))
  95
  96
  97 -- Parse the input file
  98
  99 type Parser = Parsec Void Text
 100
 101 sc :: Parser ()
 102 sc = L.space (skipSome spaceChar) CA.empty CA.empty
 103 -- sc = L.space (skipSome (char ' ')) CA.empty CA.empty
 104
 105 lexeme  = L.lexeme sc
 106 integer = lexeme L.decimal
 107 symb = L.symbol sc
 108
 109 commaP = symb ","
 110
 111
 112 coordFileP = many coordP
 113 coordP = (,) <$> integer <* commaP <*> integer
 114
 115 successfulParse :: Text -> [Coord]
 116 successfulParse input =
 117         case parse coordFileP "input" input of
 118                 Left  _error -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err
 119                 Right coords -> coords