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