Added links to optimisation blog posts

diff --git a/advent16/Main.hs b/advent16/Main.hs
index d8b44d430342fa115284dbe64562792d3b203380..cfed3535eb04ea2227c56c99c772fbac56af6c1d 100644 (file)
--- a/advent16/Main.hs
+++ b/advent16/Main.hs
@@ -1,4 +1,5 @@
 -- Writeup at https://work.njae.me.uk/2024/12/16/advent-of-code-2024-day-16/
+-- Optimisation described in https://work.njae.me.uk/2025/01/03/optimising-haskell-quick-wins/
 
 import AoC
 

diff --git a/advent18/MainBinary.hs b/advent18/MainBinary.hs
new file mode 100644 (file)
index 0000000..3bc8319
--- /dev/null
+++ b/advent18/MainBinary.hs
@@ -0,0 +1,108 @@
+-- Writeup at https://work.njae.me.uk/2024/12/18/advent-of-code-2024-day-18/
+-- Optimisation described in https://work.njae.me.uk/2025/01/03/optimising-haskell-quick-wins/
+
+-- import Debug.Trace
+
+import AoC
+import qualified Data.Set as S
+import Data.Ix
+import Data.Maybe
+-- import Data.List
+import Linear (V2(..), (^+^), (^-^))
+import Data.Text (Text)
+import qualified Data.Text.IO as TIO
+import Data.Attoparsec.Text hiding (take)
+-- import Control.Applicative
+import Algorithm.Search
+
+type Position = V2 Int -- x, y
+
+type Corrupted = S.Set Position
+
+data Memory = Memory
+  { corrupted :: Corrupted
+  , start :: Position
+  , goal :: Position
+  } deriving (Eq, Ord, Show)
+
+type Explorer = Position
+
+memoryBounds :: (Position, Position)
+-- memoryBounds = (V2 0 0, V2 6 6)
+memoryBounds = (V2 0 0, V2 70 70)
+
+main :: IO ()
+main = 
+  do  dataFileName <- getDataFileName
+      text <- TIO.readFile dataFileName
+      let bytes = successfulParse text
+      -- let memory = Memory (S.fromList $ take 12 bytes) (fst memoryBounds) (snd memoryBounds)
+      -- let memory = Memory (S.fromList $ take 1024 bytes) (fst memoryBounds) (snd memoryBounds)
+      -- print memory
+      print $ part1 bytes
+      putStrLn $ part2 bytes
+
+part1 :: [Position] -> Int
+part1 bytes = fst $ fromJust $ search $ take 1024 bytes
+
+part2 :: [Position] -> String
+part2 bytes = showResult (bytes !! (upper - 1))
+  where 
+    upper = binarySearch bytes 1024 (length bytes)
+    showResult (V2 x y) = show x ++ "," ++ show y
+
+binarySearch :: [Position] -> Int -> Int -> Int
+binarySearch bytes lower upper 
+  | lower + 1 == upper = upper
+  | escapePossible dropped = binarySearch bytes mid upper
+  | otherwise = binarySearch bytes lower mid
+  where
+    mid = (lower + upper) `div` 2
+    dropped = take mid bytes
+
+
+escapePossible :: [Position] -> Bool
+escapePossible bytes = isJust $ search bytes 
+
+search :: [Position] -> Maybe (Int, [Explorer])
+search bytes = aStar (neighbours memory) 
+                      (transitionCost)
+                      (estimateCost memory) 
+                      (isGoal memory) 
+                      (initial memory)
+  where memory = Memory (S.fromList bytes) (fst memoryBounds) (snd memoryBounds)
+
+neighbours :: Memory -> Explorer -> [Explorer]
+neighbours memory explorer = 
+  filter (`S.notMember` memory.corrupted) $
+  filter (inRange memoryBounds) 
+    [ explorer ^+^ d
+    | d <- [V2 0 1, V2 1 0, V2 0 (-1), V2 (-1) 0]
+    ]
+
+transitionCost :: Explorer -> Explorer -> Int
+transitionCost _ _ = 1
+
+isGoal :: Memory -> Explorer -> Bool
+isGoal memory e = memory.goal == e
+
+estimateCost :: Memory -> Explorer -> Int
+estimateCost memory e = (abs dr) + (abs dc)
+  where (V2 dr dc) = e ^-^ memory.goal
+
+initial :: Memory -> Explorer
+initial memory = memory.start
+
+-- parse the input file
+
+bytesP :: Parser [Position]
+byteP :: Parser Position
+
+bytesP = byteP `sepBy` endOfLine
+byteP = V2 <$> decimal <* "," <*> decimal
+
+successfulParse :: Text -> [Position]
+successfulParse input = 
+  case parseOnly bytesP input of
+    Left  _err -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err
+    Right bytes -> bytes

diff --git a/advent18/MainOriginal.hs b/advent18/MainOriginal.hs
new file mode 100644 (file)
index 0000000..27b59ca
--- /dev/null
+++ b/advent18/MainOriginal.hs
@@ -0,0 +1,105 @@
+-- Writeup at https://work.njae.me.uk/2024/12/18/advent-of-code-2024-day-18/
+
+-- import Debug.Trace
+
+import AoC
+import qualified Data.Set as S
+import Data.Ix
+import Data.Maybe
+import Data.List
+import Linear (V2(..), (^+^), (^-^))
+import Data.Text (Text)
+import qualified Data.Text.IO as TIO
+import Data.Attoparsec.Text hiding (take)
+-- import Control.Applicative
+import Algorithm.Search
+
+type Position = V2 Int -- x, y
+
+type Corrupted = S.Set Position
+
+data Memory = Memory
+  { corrupted :: Corrupted
+  , start :: Position
+  , goal :: Position
+  } deriving (Eq, Ord, Show)
+
+type Explorer = Position
+
+memoryBounds :: (Position, Position)
+-- memoryBounds = (V2 0 0, V2 6 6)
+memoryBounds = (V2 0 0, V2 70 70)
+
+main :: IO ()
+main = 
+  do  dataFileName <- getDataFileName
+      text <- TIO.readFile dataFileName
+      let bytes = successfulParse text
+      -- let memory = Memory (S.fromList $ take 12 bytes) (fst memoryBounds) (snd memoryBounds)
+      -- let memory = Memory (S.fromList $ take 1024 bytes) (fst memoryBounds) (snd memoryBounds)
+      -- print memory
+      print $ part1 bytes
+      putStrLn $ part2 bytes
+
+part1 :: [Position] -> Int
+part1 bytes = fst $ fromJust path
+  where path = aStar (neighbours memory) 
+                      (transitionCost)
+                      (estimateCost memory) 
+                      (isGoal memory) 
+                      (initial memory)
+        -- memory = Memory (S.fromList $ take 12 bytes) (fst memoryBounds) (snd memoryBounds)
+        memory = Memory (S.fromList $ take 1024 bytes) (fst memoryBounds) (snd memoryBounds)
+
+part2 :: [Position] -> String
+part2 bytes = showResult $ head $ snd $ head results
+  where 
+    (goods, poss) = splitAt 1024 bytes
+    results = dropWhile ((== True) . fst) $ scanl' go (True, goods) poss
+    go (_, acc) byte = (escapePossible (byte : acc), (byte : acc))
+    showResult (V2 x y) = show x ++ "," ++ show y
+
+escapePossible :: [Position] -> Bool
+escapePossible bytes = isJust path
+  where 
+    memory = Memory (S.fromList bytes) (fst memoryBounds) (snd memoryBounds)
+    path = aStar (neighbours memory) 
+                  (transitionCost)
+                  (estimateCost memory) 
+                  (isGoal memory) 
+                  (initial memory)
+
+neighbours :: Memory -> Explorer -> [Explorer]
+neighbours memory explorer = 
+  filter (`S.notMember` memory.corrupted) $
+  filter (inRange memoryBounds) 
+    [ explorer ^+^ d
+    | d <- [V2 0 1, V2 1 0, V2 0 (-1), V2 (-1) 0]
+    ]
+
+transitionCost :: Explorer -> Explorer -> Int
+transitionCost _ _ = 1
+
+isGoal :: Memory -> Explorer -> Bool
+isGoal memory e = memory.goal == e
+
+estimateCost :: Memory -> Explorer -> Int
+estimateCost memory e = (abs dr) + (abs dc)
+  where (V2 dr dc) = e ^-^ memory.goal
+
+initial :: Memory -> Explorer
+initial memory = memory.start
+
+-- parse the input file
+
+bytesP :: Parser [Position]
+byteP :: Parser Position
+
+bytesP = byteP `sepBy` endOfLine
+byteP = V2 <$> decimal <* "," <*> decimal
+
+successfulParse :: Text -> [Position]
+successfulParse input = 
+  case parseOnly bytesP input of
+    Left  _err -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err
+    Right bytes -> bytes

diff --git a/advent18/MainPathBlock.hs b/advent18/MainPathBlock.hs
new file mode 100644 (file)
index 0000000..bfe6cbd
--- /dev/null
+++ b/advent18/MainPathBlock.hs
@@ -0,0 +1,102 @@
+-- Writeup at https://work.njae.me.uk/2024/12/18/advent-of-code-2024-day-18/
+-- Optimisation described in https://work.njae.me.uk/2025/01/03/optimising-haskell-quick-wins/
+
+
+import AoC
+import qualified Data.Set as S
+import Data.Ix
+import Data.Maybe
+-- import Data.List
+import Linear (V2(..), (^+^), (^-^))
+import Data.Text (Text)
+import qualified Data.Text.IO as TIO
+import Data.Attoparsec.Text hiding (take)
+-- import Control.Applicative
+import Algorithm.Search
+
+type Position = V2 Int -- x, y
+
+type Corrupted = S.Set Position
+
+data Memory = Memory
+  { corrupted :: Corrupted
+  , start :: Position
+  , goal :: Position
+  } deriving (Eq, Ord, Show)
+
+type Explorer = Position
+
+memoryBounds :: (Position, Position)
+-- memoryBounds = (V2 0 0, V2 6 6)
+memoryBounds = (V2 0 0, V2 70 70)
+
+main :: IO ()
+main = 
+  do  dataFileName <- getDataFileName
+      text <- TIO.readFile dataFileName
+      let bytes = successfulParse text
+      -- let memory = Memory (S.fromList $ take 12 bytes) (fst memoryBounds) (snd memoryBounds)
+      -- let memory = Memory (S.fromList $ take 1024 bytes) (fst memoryBounds) (snd memoryBounds)
+      -- print memory
+      print $ part1 bytes
+      putStrLn $ part2 bytes
+
+part1 :: [Position] -> Int
+part1 bytes = fst $ fromJust $ search $ take 1024 bytes
+
+part2 :: [Position] -> String
+part2 bytes = showResult blocker
+  where 
+    (_, (blocker : _)) = foldl' findBlocker (snd <$> search [], []) bytes
+    showResult (V2 x y) = show x ++ "," ++ show y
+
+findBlocker :: (Maybe [Position], [Position]) -> Position -> (Maybe [Position], [Position])
+findBlocker (Nothing, dropped) _ = (Nothing, dropped)
+findBlocker (Just path, dropped) byte 
+  | byte `elem` path = (path', dropped')
+  | otherwise = (Just path, dropped')
+  where path' = snd <$> search dropped'
+        dropped' = byte : dropped
+
+search :: [Position] -> Maybe (Int, [Explorer])
+search bytes = aStar (neighbours memory) 
+                      (transitionCost)
+                      (estimateCost memory) 
+                      (isGoal memory) 
+                      (initial memory)
+  where memory = Memory (S.fromList bytes) (fst memoryBounds) (snd memoryBounds)
+
+neighbours :: Memory -> Explorer -> [Explorer]
+neighbours memory explorer = 
+  filter (`S.notMember` memory.corrupted) $
+  filter (inRange memoryBounds) 
+    [ explorer ^+^ d
+    | d <- [V2 0 1, V2 1 0, V2 0 (-1), V2 (-1) 0]
+    ]
+
+transitionCost :: Explorer -> Explorer -> Int
+transitionCost _ _ = 1
+
+isGoal :: Memory -> Explorer -> Bool
+isGoal memory e = memory.goal == e
+
+estimateCost :: Memory -> Explorer -> Int
+estimateCost memory e = (abs dr) + (abs dc)
+  where (V2 dr dc) = e ^-^ memory.goal
+
+initial :: Memory -> Explorer
+initial memory = memory.start
+
+-- parse the input file
+
+bytesP :: Parser [Position]
+byteP :: Parser Position
+
+bytesP = byteP `sepBy` endOfLine
+byteP = V2 <$> decimal <* "," <*> decimal
+
+successfulParse :: Text -> [Position]
+successfulParse input = 
+  case parseOnly bytesP input of
+    Left  _err -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err
+    Right bytes -> bytes

diff --git a/adventofcode24.cabal b/adventofcode24.cabal
index 3f0c67b75245c707d0f2a860891c50b8609d763b..890db95342da16d6fbc13e1ac5326912c4fc9328 100644 (file)
--- a/adventofcode24.cabal
+++ b/adventofcode24.cabal
@@ -190,7 +190,15 @@ executable advent17
 
 executable advent18
   import: warnings, common-extensions, build-directives, common-modules
-  main-is: advent18/Main.hs 
+  main-is: advent18/MainBinary.hs 
+  build-depends: containers, linear, attoparsec, text, search-algorithms
+executable advent18pb
+  import: warnings, common-extensions, build-directives, common-modules
+  main-is: advent18/MainPathBlock.hs 
+  build-depends: containers, linear, attoparsec, text, search-algorithms
+executable advent18orig
+  import: warnings, common-extensions, build-directives, common-modules
+  main-is: advent18/MainOriginal.hs 
   build-depends: containers, linear, attoparsec, text, search-algorithms
 executable advent18e
   import: warnings, common-extensions, build-directives, common-modules