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