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