Optimising day 15

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

diff --git a/advent15/Main.hs b/advent15/Main.hs
index 96f3213e24aec982051ca6afccf7a3918f92028f..097cf6b6850748d1a7a93294771937e4f94bb8f7 100644 (file)
--- a/advent15/Main.hs
+++ b/advent15/Main.hs
@@ -5,14 +5,24 @@ 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 qualified Data.Set as S
 import Linear hiding (Trace, trace, distance)
+import Data.List (sortOn)
+import Data.List.Split (chunksOf)
+import Data.Ord (Down(..))
+-- import Data.Maybe
+import Control.Parallel.Strategies -- (rpar, using, withStrategy, parList, parMap)
+-- import Control.DeepSeq
+
 
 type Position = V2 Int
 
 data Sensor = Sensor Position Position -- sensor position, beacon position
   deriving (Eq, Show)
 
+instance Ord Sensor where
+  (Sensor s1 b1) `compare` (Sensor s2 b2) = (s1 `manhattan` b1) `compare` (s2 `manhattan` b2)
+
 newtype Region = Region { getRegion :: Position -> Bool }  
 
 instance Semigroup Region where
@@ -27,9 +37,10 @@ main =
   do  dataFileName <- getDataFileName
       text <- TIO.readFile dataFileName
       let sensors = successfulParse text
+      let coverage = mconcat $ fmap nearby $ sortOn Down sensors
       -- print sensors
-      print $ part1 sensors
-      print $ part2 sensors
+      print $ part1 sensors coverage
+      print $ part2 sensors coverage
 
 thisY :: Int
 -- thisY = 10
@@ -39,16 +50,33 @@ 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))
+part1, part2 :: [Sensor] -> Region -> Int
+part1 sensors coverage = sum (fmap countForbidden rowChunks `using` (parList rseq))
+  where -- coverage = mconcat $ fmap nearby $ sortOn Down sensors
+        rowCoords = range ( (V2 (globalMinX sensors) thisY)
+                          , (V2 (globalMaxX sensors) thisY)
+                          )
+        rowChunks = chunksOf 1000 rowCoords
         occupied = concatMap (\(Sensor s b) -> [s, b]) sensors
+        -- forbidden = (filter (\p -> p `notElem` occupied) $ filter (getRegion coverage) rowCoords) `using` (parList rpar)
+        -- forbidden = (fmap (\p -> (getRegion coverage p, p)) rowCoords) `using` (parList rdeepseq)
+        countForbidden positions = 
+          length $ filter (\p -> p `notElem` occupied) 
+                 $ filter (getRegion coverage) positions
+
+part2 sensors coverage = x * 4000000 + y
+  where -- coverage = mconcat $ fmap nearby $ sortOn Down sensors
+        boundaries = fmap (filter (inRange searchRange)) 
+                      $ fmap justOutside sensors
+        -- holes = (fmap (filter (not . (getRegion coverage))) boundaries) `using` (parList rpar)
+        holes = fmap (filter (not . (getRegion coverage))) boundaries
+                   `using` (parList rseq)
+        -- holes = (fmap (filter (not . (getRegion coverage))) boundaries) `using` (parList rpar)
+        -- holes = withStrategy (parList rpar) (fmap (filter (not . (getRegion coverage))) boundaries)
+        -- holes = using (fmap (filter (not . (getRegion coverage))) boundaries) (parList rpar)
+        -- holes = parMap rpar (filter (not . (getRegion coverage))) boundaries
+        V2 x y = head $ concat holes
 
-part2 sensors = x * 4000000 + y
-  where coverage = mconcat $ fmap nearby sensors
-        boundaries = S.filter (inRange searchRange) $ S.unions $ fmap justOutside sensors
-        V2 x y = S.findMin $ S.filter (\p -> not $ getRegion coverage p) boundaries
 
 manhattan :: Position -> Position -> Int
 manhattan p1 p2 = (abs dx) + (abs dy)
@@ -66,8 +94,8 @@ 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)
+justOutside :: Sensor -> [Position]
+justOutside (Sensor s@(V2 sx sy) b) = 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)] ]