advent15/Main.hs

   1 -- Writeup at https://work.njae.me.uk/2022/12/15/advent-of-code-2022-day-15/
   2
   3 import AoC
   4 import Data.Text (Text)
   5 import qualified Data.Text.IO as TIO
   6 import Data.Attoparsec.Text hiding (take, D)
   7 import Control.Applicative
   8 import Data.List
   9 import Data.Ix
  10 import qualified Data.Set as S
  11 import Linear hiding (Trace, trace, distance)
  12 import Control.Lens
  13
  14 type Position = V2 Int
  15
  16 data Sensor = Sensor Position Position -- sensor position, beacon position
  17   deriving (Eq, Show)
  18
  19 newtype Region = Region { getRegion :: Position -> Bool }
  20
  21 instance Semigroup Region where
  22   r1 <> r2 = Region (\p -> getRegion r1 p || getRegion r2 p)
  23
  24 instance Monoid Region where
  25   mempty = Region (\p -> False)
  26
  27 main :: IO ()
  28 main =
  29   do  dataFileName <- getDataFileName
  30       text <- TIO.readFile dataFileName
  31       let sensors = successfulParse text
  32       -- print sensors
  33       print $ part1 sensors
  34       print $ part2 sensors
  35
  36 thisY :: Int
  37 -- thisY = 10
  38 thisY = 2000000
  39
  40 searchRange :: (Position, Position)
  41 -- searchRange = ((V2 0 0), (V2 20 20))
  42 searchRange = ((V2 0 0), (V2 4000000 4000000))
  43
  44 part1, part2 :: [Sensor] -> Int
  45 part1 sensors = length $ filter (\p -> p `notElem` occupied) $ filter (getRegion coverage) rowCoords
  46   where coverage = mconcat $ fmap nearby sensors
  47         rowCoords = range ((V2 (globalMinX sensors) thisY), (V2 (globalMaxX sensors) thisY))
  48         occupied = concatMap (\(Sensor s b) -> [s, b]) sensors
  49
  50 part2 sensors = x * 4000000 + y
  51   where coverage = mconcat $ fmap nearby sensors
  52         boundaries = S.filter (inRange searchRange) $ S.unions $ fmap justOutside sensors
  53         V2 x y = S.findMin $ S.filter (\p -> not $ getRegion coverage p) boundaries
  54
  55 manhattan :: Position -> Position -> Int
  56 manhattan p1 p2 = (abs dx) + (abs dy)
  57   where V2 dx dy = p1 ^-^ p2
  58
  59 nearby :: Sensor -> Region
  60 nearby (Sensor s b) = Region (\p -> manhattan s p <= dist)
  61   where dist = manhattan s b
  62
  63 minX, maxX :: Sensor -> Int
  64 minX (Sensor s@(V2 sx _) b) = sx - (manhattan s b)
  65 maxX (Sensor s@(V2 sx _) b) = sx + (manhattan s b)
  66
  67 globalMinX, globalMaxX :: [Sensor] -> Int
  68 globalMinX = minimum . fmap minX
  69 globalMaxX = maximum . fmap maxX
  70
  71 justOutside :: Sensor -> S.Set Position
  72 justOutside (Sensor s@(V2 sx sy) b) = S.fromList (topLeft ++ topRight ++ bottomLeft ++ bottomRight)
  73   where d = 1 + manhattan s b
  74         topLeft = [V2 x y | (x, y) <- zip [(sx - d)..sx] [sy..(sy + d)] ]
  75         topRight = [V2 x y | (x, y) <- zip [(sx + d), (sx + d - 1)..sx] [sy..(sy + d)] ]
  76         bottomLeft = [V2 x y | (x, y) <- zip [(sx - d)..sx] [sy, (sy - 1)..(sy - d)] ]
  77         bottomRight = [V2 x y | (x, y) <- zip [(sx + d), (sx + d - 1)..sx] [sy, (sy - 1)..(sy - d)] ]
  78
  79 -- Parse the input file
  80
  81 sensorsP :: Parser [Sensor]
  82 sensorP :: Parser Sensor
  83 positionP :: Parser Position
  84
  85 sensorsP = sensorP `sepBy` endOfLine
  86 sensorP = Sensor <$> ("Sensor at " *> positionP) <*> (": closest beacon is at " *> positionP)
  87 positionP = V2 <$> (("x=" *> signed decimal) <* ", ") <*> ("y=" *> signed decimal)
  88
  89 successfulParse :: Text -> [Sensor]
  90 successfulParse input =
  91   case parseOnly sensorsP input of
  92     Left  _err -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err
  93     Right sensors -> sensors