From: Neil Smith Date: Fri, 3 Jan 2025 18:20:58 +0000 (+0000) Subject: Added links to optimisation blog posts X-Git-Url: https://git.njae.me.uk/?a=commitdiff_plain;h=85cf8d1b23b2adb3fcac125d0fb8faec89651ba9;p=advent-of-code-24.git Added links to optimisation blog posts --- diff --git a/advent16/Main.hs b/advent16/Main.hs index d8b44d4..cfed353 100644 --- 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 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 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 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 3f0c67b..890db95 100644 --- 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