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