fuxino/AdventOfCode2024
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

More refactoring

Browse Source
This commit is contained in:
daniele 2024-12-20 18:54:05 +01:00
parent cff92ce34f
commit 176b562eb4
Signed by: fuxino
GPG Key ID: 981A2B2A3BBF5514
4 changed files with 73 additions and 62 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
adventofcode2024.cabal
View File

@ -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

3
src/Day10.hs
View File

@ -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]

62
src/Day18.hs
View File

@ -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) /= '#']

68
src/Graph.hs Normal file
View File

@ -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))