Optimising day 15

[advent-of-code-22.git] / advent15 / MainOriginal.hs

diff --git a/advent15/MainOriginal.hs b/advent15/MainOriginal.hs
new file mode 100644 (file)
index 0000000..d04b1ea
--- /dev/null
+++ b/advent15/MainOriginal.hs
@@ -0,0 +1,91 @@
+-- Writeup at https://work.njae.me.uk/2022/12/15/advent-of-code-2022-day-15/
+
+import AoC
+import Data.Text (Text)
+import qualified Data.Text.IO as TIO
+import Data.Attoparsec.Text hiding (take, D)
+import Data.Ix
+import qualified Data.Set as S
+import Linear hiding (Trace, trace, distance)
+
+type Position = V2 Int
+
+data Sensor = Sensor Position Position -- sensor position, beacon position
+  deriving (Eq, Show)
+
+newtype Region = Region { getRegion :: Position -> Bool }  
+
+instance Semigroup Region where
+  r1 <> r2 = Region (\p -> getRegion r1 p || getRegion r2 p)
+
+instance Monoid Region where
+  -- mempty = Region (\p -> False)
+  mempty = Region (const False)
+
+main :: IO ()
+main = 
+  do  dataFileName <- getDataFileName
+      text <- TIO.readFile dataFileName
+      let sensors = successfulParse text
+      -- print sensors
+      print $ part1 sensors
+      print $ part2 sensors
+
+thisY :: Int
+-- thisY = 10
+thisY = 2000000
+
+searchRange :: (Position, Position)
+-- searchRange = ((V2 0 0), (V2 20 20))
+searchRange = ((V2 0 0), (V2 4000000 4000000))
+
+part1, part2 :: [Sensor] -> Int
+part1 sensors = length $ filter (\p -> p `notElem` occupied) $ filter (getRegion coverage) rowCoords
+  where coverage = mconcat $ fmap nearby sensors
+        rowCoords = range ((V2 (globalMinX sensors) thisY), (V2 (globalMaxX sensors) thisY))
+        occupied = concatMap (\(Sensor s b) -> [s, b]) sensors
+
+part2 sensors = x * 4000000 + y
+  where coverage = mconcat $ fmap nearby sensors
+        boundaries = {-# SCC boundaries #-} S.filter (inRange searchRange) $ S.unions $ fmap justOutside sensors
+        V2 x y = {-# SCC findMinV #-} S.findMin $ S.filter (not . (getRegion coverage)) boundaries
+
+manhattan :: Position -> Position -> Int
+manhattan p1 p2 = (abs dx) + (abs dy)
+  where V2 dx dy = p1 ^-^ p2
+
+nearby :: Sensor -> Region
+nearby (Sensor s b) = Region (\p -> manhattan s p <= dist)
+  where dist = manhattan s b
+
+minX, maxX :: Sensor -> Int
+minX (Sensor s@(V2 sx _) b) = sx - (manhattan s b)
+maxX (Sensor s@(V2 sx _) b) = sx + (manhattan s b)
+
+globalMinX, globalMaxX :: [Sensor] -> Int
+globalMinX = minimum . fmap minX
+globalMaxX = maximum . fmap maxX
+
+justOutside :: Sensor -> S.Set Position
+justOutside (Sensor s@(V2 sx sy) b) = S.fromList (topLeft ++ topRight ++ bottomLeft ++ bottomRight)
+  where d = 1 + manhattan s b
+        topLeft = [V2 x y | (x, y) <- zip [(sx - d)..sx] [sy..(sy + d)] ]
+        topRight = [V2 x y | (x, y) <- zip [(sx + d), (sx + d - 1)..sx] [sy..(sy + d)] ]
+        bottomLeft = [V2 x y | (x, y) <- zip [(sx - d)..sx] [sy, (sy - 1)..(sy - d)] ]
+        bottomRight = [V2 x y | (x, y) <- zip [(sx + d), (sx + d - 1)..sx] [sy, (sy - 1)..(sy - d)] ]
+
+-- Parse the input file
+
+sensorsP :: Parser [Sensor]
+sensorP :: Parser Sensor
+positionP :: Parser Position
+
+sensorsP = sensorP `sepBy` endOfLine
+sensorP = Sensor <$> ("Sensor at " *> positionP) <*> (": closest beacon is at " *> positionP)
+positionP = V2 <$> (("x=" *> signed decimal) <* ", ") <*> ("y=" *> signed decimal)
+
+successfulParse :: Text -> [Sensor]
+successfulParse input = 
+  case parseOnly sensorsP input of
+    Left  _err -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err
+    Right sensors -> sensors