diff --git a/adventofcode2024.cabal b/adventofcode2024.cabal index 1cf919a..2bf8d99 100644 --- a/adventofcode2024.cabal +++ b/adventofcode2024.cabal @@ -19,11 +19,12 @@ executable adventofcode2024 main-is: Main.hs default-language: Haskell2010 build-depends: base >= 4.7 && < 5 - , split + , array , containers - , regex-tdfa , matrix , mtl + , regex-tdfa + , split ghc-options: -Wall -Wcompat -Widentities @@ -62,3 +63,4 @@ executable adventofcode2024 Day14.Puzzle2 Day15.Puzzle1 Day17.Puzzle1 + Day18.Puzzle1 diff --git a/src/Day18/Puzzle1.hs b/src/Day18/Puzzle1.hs new file mode 100644 index 0000000..509e2d9 --- /dev/null +++ b/src/Day18/Puzzle1.hs @@ -0,0 +1,80 @@ +module Day18.Puzzle1 (day18_1) where + +import Data.Array (Array, indices, listArray, (!), (//)) +import Data.Function (on) +import Data.List (minimumBy) +import Data.List.Split (splitOn) +import qualified Data.Map as M +import qualified Data.Set as S + +type Coords = (Int, Int) + +newtype Graph = Graph {edges :: M.Map Coords [Coords]} deriving (Show) + +data Distance a = Dist a | Infinity deriving (Eq) + +instance (Ord a) => Ord (Distance a) where + Infinity <= Infinity = True + Infinity <= Dist _ = False + Dist _ <= Infinity = True + Dist x <= Dist y = x <= y + +instance (Show a) => Show (Distance a) where + show Infinity = "Infinity" + show (Dist x) = show x + +data DijkstraState = DijkstraState + { unvisited :: S.Set Coords, + distances :: M.Map Coords (Distance Int) + } + deriving (Show) + +addDistance :: (Num a) => Distance a -> Distance a -> Distance a +addDistance (Dist x) (Dist y) = Dist (x + y) +addDistance _ _ = Infinity + +corruptMemory :: Array Coords Char -> [Coords] -> Array Coords Char +corruptMemory = foldl (\a b -> a // [(b, '#')]) + +adjacent :: Array Coords Char -> Coords -> Coords -> [Coords] +adjacent array (i, j) (maxI, maxJ) = [(a, b) | (a, b) <- [(i, j + 1), (i, j - 1), (i + 1, j), (i - 1, j)], a >= 0, b >= 0, a <= maxI, b <= maxJ, array ! (a, b) /= '#'] + +initDijkstraState :: Coords -> Graph -> DijkstraState +initDijkstraState start g = + let s = + DijkstraState + { unvisited = S.fromList . M.keys $ edges g, + distances = M.fromList $ zip (M.keys $ edges g) (repeat Infinity) + } + in s {distances = M.adjust (const (Dist 0)) start (distances s)} + +updateDistances :: Graph -> M.Map Coords (Distance Int) -> Coords -> M.Map Coords (Distance Int) +updateDistances graph dists coords = + let nodes = edges graph M.! coords + dist = dists M.! coords + in M.mapWithKey (\k d -> if k `elem` nodes && d > dist then addDistance dist (Dist 1) else d) dists + +findShortestPath :: Graph -> DijkstraState -> Coords -> Coords -> Distance Int +findShortestPath graph state start end + | start == end = distances state M.! end + | S.null (unvisited state) = distances state M.! end + | distances state M.! start == Infinity = Infinity + | otherwise = + let newState = + state + { unvisited = S.delete start (unvisited state), + distances = updateDistances graph (distances state) start + } + nodes = S.toList $ unvisited newState + next = fst $ minimumBy (compare `on` snd) [(n, distances newState M.! n) | n <- nodes] + in findShortestPath graph newState next end + +day18_1 :: IO () +day18_1 = do + contents <- map (splitOn ",") . lines <$> readFile "input/day18.txt" + let memory = listArray ((0, 0), (70, 70)) $ replicate 5041 '.' + coords = take 1024 [(read x, read y) | (x : y : _) <- contents] + memory' = corruptMemory memory coords + memoryMap = Graph {edges = M.fromList [(k, adjacent memory' k (70, 70)) | k <- indices memory']} + state = initDijkstraState (0, 0) memoryMap + putStrLn $ "Day 18, Puzzle 1 solution: " ++ show (findShortestPath memoryMap state (0, 0) (70, 70)) diff --git a/src/Main.hs b/src/Main.hs index 9686155..af16dd4 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -28,6 +28,7 @@ import Day14.Puzzle1 import Day14.Puzzle2 import Day15.Puzzle1 import Day17.Puzzle1 +import Day18.Puzzle1 import System.Environment (getArgs) main :: IO () @@ -62,4 +63,5 @@ main = do "14" : "2" : _ -> day14_2 "15" : "1" : _ -> day15_1 "17" : "1" : _ -> day17_1 + "18" : "1" : _ -> day18_1 _ -> error "Not implemented"