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