From 176b562eb4fbe5c15ef1c96755987c9cca6e903e Mon Sep 17 00:00:00 2001 From: Daniele Fucini Date: Fri, 20 Dec 2024 18:54:05 +0100 Subject: [PATCH] More refactoring --- adventofcode2024.cabal | 2 ++ src/Day10.hs | 3 +- src/Day18.hs | 62 ++------------------------------------ src/Graph.hs | 68 ++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 73 insertions(+), 62 deletions(-) create mode 100644 src/Graph.hs diff --git a/adventofcode2024.cabal b/adventofcode2024.cabal index 1c4e0ed..2a5684d 100644 --- a/adventofcode2024.cabal +++ b/adventofcode2024.cabal @@ -21,6 +21,7 @@ executable adventofcode2024 build-depends: base >= 4.7 && < 5 , array , containers + , hashable , matrix , mtl , PSQueue @@ -55,3 +56,4 @@ executable adventofcode2024 Day17 Day18 Day19 + Graph diff --git a/src/Day10.hs b/src/Day10.hs index 0dbcdf6..9674dad 100644 --- a/src/Day10.hs +++ b/src/Day10.hs @@ -7,11 +7,10 @@ where import qualified Data.Array as A import Data.Char (digitToInt) import qualified Data.HashMap.Strict as M +import Graph type Coords = (Int, Int) -newtype Graph a = Graph {edges :: M.HashMap a [a]} deriving (Show) - adjacent :: A.Array Coords Int -> 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) - array A.! (i, j) == 1] diff --git a/src/Day18.hs b/src/Day18.hs index 5bb0196..7f4daaf 100644 --- a/src/Day18.hs +++ b/src/Day18.hs @@ -1,4 +1,4 @@ -{-# OPTIONS_GHC -Wno-incomplete-patterns #-} +{-# OPTIONS_GHC -Wno-incomplete-patterns -Wno-type-defaults #-} module Day18 ( day18_1, @@ -9,68 +9,10 @@ where import qualified Data.Array as A import qualified Data.HashMap.Strict as M import Data.List.Split (splitOn) -import Data.Maybe (fromJust) -import qualified Data.PSQueue as PQ +import Graph type Coords = (Int, Int) -newtype Graph = Graph {edges :: M.HashMap 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 - -addDistance :: (Num a) => Distance a -> Distance a -> Distance a -addDistance (Dist x) (Dist y) = Dist (x + y) -addDistance _ _ = Infinity - -data DijkstraState = DijkstraState - { unvisited :: PQ.PSQ Coords (Distance Int), - distances :: M.HashMap Coords (Distance Int) - } - -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 - -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 - -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) /= '#'] diff --git a/src/Graph.hs b/src/Graph.hs new file mode 100644 index 0000000..aef77c1 --- /dev/null +++ b/src/Graph.hs @@ -0,0 +1,68 @@ +module Graph + ( Graph (..), + Distance (..), + findShortestPath, + ) +where + +import qualified Data.HashMap.Strict as M +import Data.Hashable (Hashable) +import Data.Maybe (fromJust) +import qualified Data.PSQueue as PQ + +newtype Graph a = Graph {edges :: M.HashMap a [a]} 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 + +addDistance :: (Num a) => Distance a -> Distance a -> Distance a +addDistance (Dist x) (Dist y) = Dist (x + y) +addDistance _ _ = Infinity + +data DijkstraState a b = DijkstraState + { unvisited :: PQ.PSQ a (Distance b), + distances :: M.HashMap a (Distance b) + } + +updateDistances :: (Hashable a) => M.HashMap a (Distance b) -> [a] -> Distance b -> M.HashMap a (Distance b) +updateDistances dists [] _ = dists +updateDistances dists (n : nodes) startD = + updateDistances (M.adjust (const startD) n dists) nodes startD + +visit :: (Ord a, Ord b) => PQ.PSQ a (Distance b) -> a -> [a] -> Distance b -> PQ.PSQ a (Distance b) +visit us node [] _ = PQ.delete node us +visit us node (e : es) dist = visit (PQ.adjust (const dist) e us) node es dist + +visitNode :: (Hashable a, Ord a, Ord b) => DijkstraState a b -> Graph a -> a -> Distance b -> DijkstraState a b +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 :: (Hashable a, Ord a, Ord b, Num b) => Graph a -> a -> a -> Distance b +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))