Optimising day 15
authorNeil Smith <NeilNjae@users.noreply.github.com>
Thu, 29 Dec 2022 16:09:33 +0000 (16:09 +0000)
committerNeil Smith <NeilNjae@users.noreply.github.com>
Thu, 29 Dec 2022 16:11:09 +0000 (16:11 +0000)
12 files changed:
README.md
advent-of-code22.cabal
advent15/Main.hs
advent15/MainDirectParallel.hs [new file with mode: 0644]
advent15/MainLazy.hs [new file with mode: 0644]
advent15/MainOriginal.hs [new file with mode: 0644]
advent15/MainSorted.hs [new file with mode: 0644]
advent15/advent15.png [new file with mode: 0644]
advent15/advent15directpar.png [new file with mode: 0644]
advent15/advent15lazy.png [new file with mode: 0644]
advent15/advent15times.csv [new file with mode: 0644]
advent15/advent15times.md [new file with mode: 0644]

index 7dcb1e77dd9fb72c930512366aece659ee7bea15..a617b7cc29a94d497c91f5cb70c9a08161f9a08d 100644 (file)
--- a/README.md
+++ b/README.md
@@ -86,9 +86,12 @@ executable advent01prof
   ghc-options:         -O2 
                        -Wall 
                        -threaded 
+                       -eventlog
                        -rtsopts "-with-rtsopts=-N -p -s -hT"
 ```
 
+Only include the `-eventlog` directive if you want to use Threadscope to investigate parallel behaviour.
+
 then running 
 
 ```
index 76f7671cdbc639e2f77e7dc057020fc235738257..54649c9c3514d9099ea8ad02bdfae398823d50dc 100644 (file)
@@ -62,7 +62,7 @@ common common-extensions
                         , RecordWildCards
                         , ScopedTypeVariables
                         , TemplateHaskell
-                        , TransformListComp
+                        -- , TransformListComp
                         , TupleSections
                         , TypeApplications
                         , TypeFamilies
@@ -171,10 +171,40 @@ executable advent14
   main-is: advent14/Main.hs
   build-depends: text, attoparsec, containers, linear, lens
 
+executable advent15original
+  import: common-extensions, build-directives
+  main-is: advent15/MainOriginal.hs
+  build-depends: text, attoparsec, containers, linear, lens
+
+executable advent15sorted
+  import: common-extensions, build-directives
+  main-is: advent15/MainSorted.hs
+  build-depends: text, attoparsec, containers, linear, lens
+
+executable advent15lazy
+  import: common-extensions, build-directives
+  main-is: advent15/MainLazy.hs
+  build-depends: text, attoparsec, containers, linear, lens
+
+executable advent15directpar
+  import: common-extensions, build-directives
+  main-is: advent15/MainDirectParallel.hs
+  build-depends: text, attoparsec, containers, linear, lens, parallel, deepseq
+  
 executable advent15
   import: common-extensions, build-directives
   main-is: advent15/Main.hs
-  build-depends: text, attoparsec, containers, linear, lens
+  build-depends: text, attoparsec, containers, linear, lens, parallel, deepseq, split
+
+executable advent15prof
+  import: common-extensions, build-directives
+  main-is: advent15/Main.hs
+  build-depends: text, attoparsec, containers, linear, lens, parallel, deepseq, split
+  ghc-options:         -O2 
+                       -Wall 
+                       -threaded 
+                       -eventlog
+                       -rtsopts "-with-rtsopts=-N -p -s -hT -ls"
 
 executable advent16
   import: common-extensions, build-directives
index 96f3213e24aec982051ca6afccf7a3918f92028f..097cf6b6850748d1a7a93294771937e4f94bb8f7 100644 (file)
@@ -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)] ]
diff --git a/advent15/MainDirectParallel.hs b/advent15/MainDirectParallel.hs
new file mode 100644 (file)
index 0000000..ccf29d9
--- /dev/null
@@ -0,0 +1,115 @@
+-- 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)
+import Data.List (sortOn)
+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
+  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
+      let coverage = mconcat $ fmap nearby $ sortOn Down sensors
+      -- print sensors
+      print $ part1 sensors coverage
+      print $ part2 sensors coverage
+
+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] -> Region -> Int
+part1 sensors coverage = length $ filter (\p -> p `notElem` occupied) 
+                                $ fmap snd $ filter fst forbidden
+  where -- coverage = mconcat $ fmap nearby $ sortOn Down sensors
+        rowCoords = range ( (V2 (globalMinX sensors) thisY)
+                          , (V2 (globalMaxX sensors) thisY)
+                          )
+        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)
+
+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 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
+
+
+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 -> [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)] ]
+        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
diff --git a/advent15/MainLazy.hs b/advent15/MainLazy.hs
new file mode 100644 (file)
index 0000000..8b85ccc
--- /dev/null
@@ -0,0 +1,99 @@
+-- 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)
+import Data.List (sortOn)
+import Data.Ord (Down(..))
+-- import Data.Maybe
+
+
+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
+  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 $ sortOn Down 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 $ sortOn Down sensors
+        boundaries = fmap (filter (inRange searchRange)) $ fmap justOutside sensors
+        V2 x y = head $ concat $ fmap (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 -> [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)] ]
+        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
diff --git a/advent15/MainOriginal.hs b/advent15/MainOriginal.hs
new file mode 100644 (file)
index 0000000..d04b1ea
--- /dev/null
@@ -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
diff --git a/advent15/MainSorted.hs b/advent15/MainSorted.hs
new file mode 100644 (file)
index 0000000..7fcd5e0
--- /dev/null
@@ -0,0 +1,102 @@
+-- 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)
+import Data.List (sortOn)
+import Data.Ord (Down(..))
+
+
+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) 
+  --   | cmp == EQ = s1 `compare` s2
+  --   | otherwise = cmp
+  --   where cmp = (s1 `manhattan` b1) `compare` (s2 `manhattan` b2)
+ (Sensor s1 b1) `compare` (Sensor s2 b2) 
+     = (s1 `manhattan` b1) `compare` (s2 `manhattan` b2)
+
+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 $ sortOn Down 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 $ sortOn Down 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
diff --git a/advent15/advent15.png b/advent15/advent15.png
new file mode 100644 (file)
index 0000000..7cfeee9
Binary files /dev/null and b/advent15/advent15.png differ
diff --git a/advent15/advent15directpar.png b/advent15/advent15directpar.png
new file mode 100644 (file)
index 0000000..3ed68ac
Binary files /dev/null and b/advent15/advent15directpar.png differ
diff --git a/advent15/advent15lazy.png b/advent15/advent15lazy.png
new file mode 100644 (file)
index 0000000..1ea4d79
Binary files /dev/null and b/advent15/advent15lazy.png differ
diff --git a/advent15/advent15times.csv b/advent15/advent15times.csv
new file mode 100644 (file)
index 0000000..c3d17b9
--- /dev/null
@@ -0,0 +1,9 @@
+cabal run advent15original advent15,18.47,202.19,2:02.91,17888168
+cabal run advent15sorted advent15,18.09,189.46,2:00.68,17886248
+cabal run advent15lazy advent15,0.10,5.69,0:05.64,80708
+cabal run advent15directpar advent15,3.34,27.14,0:11.49,1322200
+cabal run advent15 advent15,0.82,15.22,0:02.90,726936
+cabal run advent15,0.95,17.88,0:05.89,730904
+cabal run advent15,0.59,14.82,0:02.36,792416
+cabal run advent15,0.84,17.90,0:05.65,690064
+cabal run advent15,0.70,14.46,0:02.36,672592
diff --git a/advent15/advent15times.md b/advent15/advent15times.md
new file mode 100644 (file)
index 0000000..7dd8a25
--- /dev/null
@@ -0,0 +1,7 @@
+| Program                  | &nbsp;System time&nbsp; | &nbsp;User time&nbsp; | &nbsp;Wall time&nbsp; | &nbsp;Memory used (kb)&nbsp; |
+|:-------------------------|------------:|----------:|----------:|------------:|
+| Original                 |       18.47 |    202.19 |   2:02.91 |  17,888,168 |
+| Sorted region            |       18.09 |    189.46 |   2:00.68 |  17,886,248 |
+| Lazy boundary creation   |        0.10 |      5.69 |   0:05.64 |      80,708 |
+| Direct parallelism       |        3.34 |     27.14 |   0:11.49 |   1,322,200 |
+| Parallelism and chunking |        0.59 |     14.82 |   0:02.36 |     672,592 |