diff --git a/adventofcode2024.cabal b/adventofcode2024.cabal index 836c9ed..af94059 100644 --- a/adventofcode2024.cabal +++ b/adventofcode2024.cabal @@ -23,8 +23,10 @@ executable adventofcode2024 , containers , matrix , mtl + , PSQueue , regex-tdfa , split + , unordered-containers ghc-options: -Wall -Wcompat -Widentities diff --git a/src/Day18/Puzzle1.hs b/src/Day18/Puzzle1.hs index 803a510..36ac115 100644 --- a/src/Day18/Puzzle1.hs +++ b/src/Day18/Puzzle1.hs @@ -1,15 +1,14 @@ module Day18.Puzzle1 (day18_1) where import qualified Data.Array as A -import Data.Function (on) -import Data.List (minimumBy) +import qualified Data.HashMap.Strict as M import Data.List.Split (splitOn) -import qualified Data.Map.Strict as M -import qualified Data.Set as S +import Data.Maybe (fromJust) +import qualified Data.PSQueue as PQ type Coords = (Int, Int) -newtype Graph = Graph {edges :: M.Map Coords [Coords]} deriving (Show) +newtype Graph = Graph {edges :: M.HashMap Coords [Coords]} deriving (Show) data Distance a = Dist a | Infinity deriving (Eq) @@ -28,38 +27,43 @@ addDistance (Dist x) (Dist y) = Dist (x + y) addDistance _ _ = Infinity data DijkstraState = DijkstraState - { unvisited :: S.Set Coords, - distances :: M.Map Coords (Distance Int) + { unvisited :: PQ.PSQ Coords (Distance Int), + distances :: M.HashMap Coords (Distance Int) } - deriving (Show) -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 :: M.HashMap Coords (Distance Int) -> [Coords] -> Distance Int -> M.HashMap Coords (Distance Int) +updateDistances dists [] _ = dists +updateDistances dists (n : nodes) startD = + updateDistances (M.adjust (const startD) n dists) nodes startD -updateDistances :: Graph -> M.Map Coords (Distance Int) -> [Coords] -> Distance Int -> M.Map Coords (Distance Int) -updateDistances _ dists [] _ = dists -updateDistances graph dists (n : nodes) startD = - updateDistances graph (M.adjust (const (addDistance startD (Dist 1))) n dists) nodes startD +visit :: PQ.PSQ Coords (Distance Int) -> Coords -> [Coords] -> Distance Int -> PQ.PSQ Coords (Distance Int) +visit us node [] _ = PQ.delete node us +visit us node (e : es) dist = visit (PQ.adjust (const dist) e us) node es dist -findShortestPath :: Graph -> DijkstraState -> Coords -> Coords -> Distance Int -findShortestPath graph state start end - | start == end = 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) (edges graph M.! start) (distances state M.! 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 +visitNode :: DijkstraState -> Graph -> Coords -> Distance Int -> DijkstraState +visitNode state graph node d = + let es = edges graph M.! node + ds = updateDistances (distances state) es d + us = visit (unvisited state) node es d + in state {unvisited = us, distances = ds} + +findShortestPath :: Graph -> Coords -> Coords -> Distance Int +findShortestPath graph start end = + let nodesDist = (start PQ.:-> Dist 0) : [k PQ.:-> Infinity | k <- M.keys $ edges graph, k /= start] + dists = (start, Dist 0) : [(k, Infinity) | k <- M.keys $ edges graph, k /= start] + initialState = DijkstraState {unvisited = PQ.fromList nodesDist, distances = M.fromList dists} + in dijkstra initialState + where + dijkstra s = + let nd = fromJust $ PQ.findMin (unvisited s) + n = PQ.key nd + d = PQ.prio nd + in if n == end + then d + else + if d == Infinity + then Infinity + else dijkstra $ visitNode s graph n (addDistance d (Dist 1)) adjacent :: A.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.! (a, b) /= '#'] @@ -74,5 +78,4 @@ day18_1 = do coords = take 1024 [(read x, read y) | (x : y : _) <- contents] memory' = corruptMemory memory coords memoryGraph = Graph {edges = M.fromList [(k, adjacent memory' k (70, 70)) | k <- A.indices memory']} - state = initDijkstraState (0, 0) memoryGraph - putStrLn $ "Day 18, Puzzle 1 solution: " ++ show (findShortestPath memoryGraph state (0, 0) (70, 70)) + putStrLn $ "Day 18, Puzzle 1 solution: " ++ show (findShortestPath memoryGraph (0, 0) (70, 70)) diff --git a/src/Day18/Puzzle2.hs b/src/Day18/Puzzle2.hs index 6b3fc90..5eb8c6b 100644 --- a/src/Day18/Puzzle2.hs +++ b/src/Day18/Puzzle2.hs @@ -1,15 +1,16 @@ +{-# OPTIONS_GHC -Wno-incomplete-patterns #-} + module Day18.Puzzle2 (day18_2) where import qualified Data.Array as A -import Data.Function (on) -import Data.List (minimumBy) +import qualified Data.HashMap.Strict as M import Data.List.Split (splitOn) -import qualified Data.Map.Strict as M -import qualified Data.Set as S +import Data.Maybe (fromJust) +import qualified Data.PSQueue as PQ type Coords = (Int, Int) -newtype Graph = Graph {edges :: M.Map Coords [Coords]} deriving (Show) +newtype Graph = Graph {edges :: M.HashMap Coords [Coords]} deriving (Show) data Distance a = Dist a | Infinity deriving (Eq) @@ -28,38 +29,44 @@ addDistance (Dist x) (Dist y) = Dist (x + y) addDistance _ _ = Infinity data DijkstraState = DijkstraState - { unvisited :: S.Set Coords, - distances :: M.Map Coords (Distance Int) + { unvisited :: PQ.PSQ Coords (Distance Int), + distances :: M.HashMap Coords (Distance Int) } deriving (Show) -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 :: M.HashMap Coords (Distance Int) -> [Coords] -> Distance Int -> M.HashMap Coords (Distance Int) +updateDistances dists [] _ = dists +updateDistances dists (n : nodes) startD = + updateDistances (M.adjust (const startD) n dists) nodes startD -updateDistances :: Graph -> M.Map Coords (Distance Int) -> [Coords] -> Distance Int -> M.Map Coords (Distance Int) -updateDistances _ dists [] _ = dists -updateDistances graph dists (n : nodes) startD = - updateDistances graph (M.adjust (const (addDistance startD (Dist 1))) n dists) nodes startD +visit :: PQ.PSQ Coords (Distance Int) -> Coords -> [Coords] -> Distance Int -> PQ.PSQ Coords (Distance Int) +visit us node [] _ = PQ.delete node us +visit us node (e : es) dist = visit (PQ.adjust (const dist) e us) node es dist -findShortestPath :: Graph -> DijkstraState -> Coords -> Coords -> Distance Int -findShortestPath graph state start end - | start == end = 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) (edges graph M.! start) (distances state M.! 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 +visitNode :: DijkstraState -> Graph -> Coords -> Distance Int -> DijkstraState +visitNode state graph node d = + let es = edges graph M.! node + ds = updateDistances (distances state) es d + us = visit (unvisited state) node es d + in state {unvisited = us, distances = ds} + +findShortestPath :: Graph -> Coords -> Coords -> Distance Int +findShortestPath graph start end = + let nodesDist = (start PQ.:-> Dist 0) : [k PQ.:-> Infinity | k <- M.keys $ edges graph, k /= start] + dists = (start, Dist 0) : [(k, Infinity) | k <- M.keys $ edges graph, k /= start] + initialState = DijkstraState {unvisited = PQ.fromList nodesDist, distances = M.fromList dists} + in dijkstra initialState + where + dijkstra s = + let nd = fromJust $ PQ.findMin (unvisited s) + n = PQ.key nd + d = PQ.prio nd + in if n == end + then d + else + if d == Infinity + then Infinity + else dijkstra $ visitNode s graph n (addDistance d (Dist 1)) adjacent :: A.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.! (a, b) /= '#'] @@ -71,8 +78,7 @@ findFirstBlocker :: A.Array Coords Char -> [Coords] -> Coords -> Coords -> Coord findFirstBlocker memory (c:cs) start end = let memory' = corruptMemory memory [c] memoryGraph = Graph {edges = M.fromList [(k, adjacent memory' k (70, 70)) | k <- A.indices memory']} - state = initDijkstraState (0, 0) memoryGraph - in if findShortestPath memoryGraph state start end == Infinity + in if findShortestPath memoryGraph start end == Infinity then c else findFirstBlocker memory' cs start end