From c2d505676f187a775d159f5cfdc25c5fb4ffd45f Mon Sep 17 00:00:00 2001 From: Neil Smith Date: Wed, 18 Dec 2024 12:16:35 +0000 Subject: [PATCH] Done day 18 --- advent17/Main.hs | 1 - advent18/Main.hs | 105 ++++++++++++++++++++++++++++++++++ advent18/MainExplorer.hs | 119 +++++++++++++++++++++++++++++++++++++++ adventofcode24.cabal | 9 +++ 4 files changed, 233 insertions(+), 1 deletion(-) create mode 100644 advent18/Main.hs create mode 100644 advent18/MainExplorer.hs diff --git a/advent17/Main.hs b/advent17/Main.hs index 51dccad..d9f5a16 100644 --- a/advent17/Main.hs +++ b/advent17/Main.hs @@ -1,6 +1,5 @@ -- Writeup at https://work.njae.me.uk/2024/12/17/advent-of-code-2024-day-17/ - import AoC import Data.Text (Text) import qualified Data.Text.IO as TIO diff --git a/advent18/Main.hs b/advent18/Main.hs new file mode 100644 index 0000000..27b59ca --- /dev/null +++ b/advent18/Main.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/MainExplorer.hs b/advent18/MainExplorer.hs new file mode 100644 index 0000000..8d63149 --- /dev/null +++ b/advent18/MainExplorer.hs @@ -0,0 +1,119 @@ +-- 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) + +data Explorer = Explorer + { pos :: Position + , ct :: Int + } + -- deriving (Eq, Ord, Show) + deriving (Eq, Show) +instance Ord Explorer where + compare e1 e2 = compare (pos e1) (pos e2) + -- compare e1 e2 = case pc of + -- EQ -> compare (ct e1) (ct e2) + -- _ -> pc + -- where pc = compare (pos e1) (pos e2) + +-- 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 + print $ 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 + results = dropWhile ((== True) . fst) $ scanl' go (True, []) bytes + -- results = scanl' go (True, []) (take 22 bytes) + 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) . pos) $ + filter ((inRange memoryBounds) . pos) + [ explorer {pos = explorer.pos ^+^ d , ct = explorer.ct + 1} + | 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.pos + +estimateCost :: Memory -> Explorer -> Int +estimateCost memory e = (abs dx) + (abs dy) + where (V2 dx dy) = e.pos ^-^ memory.goal + +initial :: Memory -> Explorer +-- initial memory = Explorer { pos = memory.start } +initial memory = Explorer { pos = memory.start, ct = 0 } + +-- 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 e89d9c4..fabde5f 100644 --- a/adventofcode24.cabal +++ b/adventofcode24.cabal @@ -172,4 +172,13 @@ executable advent17 import: warnings, common-extensions, build-directives, common-modules main-is: advent17/Main.hs build-depends: containers, text, attoparsec, mtl + +executable advent18 + import: warnings, common-extensions, build-directives, common-modules + main-is: advent18/Main.hs + build-depends: containers, linear, attoparsec, text, search-algorithms +executable advent18e + import: warnings, common-extensions, build-directives, common-modules + main-is: advent18/MainExplorer.hs + build-depends: containers, linear, attoparsec, text, search-algorithms \ No newline at end of file -- 2.34.1