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

Day 16, Part 1

Browse Source
This commit is contained in:
daniele 2024-12-22 15:14:20 +01:00
parent 2e6e6ac224
commit 7fb9abecb8
Signed by: fuxino
GPG Key ID: 981A2B2A3BBF5514
7 changed files with 85 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
README.md
View File

@ -3,7 +3,7 @@ I started learning Haskell very recently, and I just learned this year that Adve
|Day|Stars|Day|Stars|Day|Stars|Day|Stars|Day|Stars|
|---|-----|---|-----|---|-----|---|-----|---|-----|
|01 |★ ★ |06 |★ ★ |11 |★ ★ |16 | |21 | |
|01 |★ ★ |06 |★ ★ |11 |★ ★ |16 |★ |21 | |
|02 |★ ★ |07 |★ ★ |12 |★ |17 |★ ★ |22 |★ |
|03 |★ ★ |08 |★ ★ |13 |★ ★ |18 |★ ★ |23 | |
|04 |★ ★ |09 |★ ★ |14 |★ ★ |19 |★ |24 | |

1
adventofcode2024.cabal
View File

@ -53,6 +53,7 @@ executable adventofcode2024
Day13
Day14
Day15
Day16
Day17
Day18
Day19

22
src/Day10.hs
View File

@ -11,30 +11,30 @@ import Graph
type Coords = (Int, Int)
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]
adjacent :: (Num a) => A.Array Coords Int -> Coords -> Coords -> [(Coords, Distance a)]
adjacent array (i, j) (maxI, maxJ) = [((a, b), Dist 1) | (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]
findAllPaths :: Graph Coords -> Coords -> Coords -> [Coords] -> [[Coords]]
findAllPaths :: Graph Coords Int -> Coords -> Coords -> [Coords] -> [[Coords]]
findAllPaths graph start end path = do
node <- edges graph M.! start
node <- fst <$> edges graph M.! start
let path' = path ++ [node]
if node == end
then return path'
else findAllPaths graph node end path'
getTrailGraph :: A.Array Coords Int -> (Graph Coords Int, [Coords], [Coords])
getTrailGraph trailMap =
let trailGraph = Graph {edges = M.fromList [(k, adjacent trailMap k (52, 52)) | k <- A.indices trailMap]}
startList = map fst . filter (\(_, y) -> y == 0) $ A.assocs trailMap
endList = map fst . filter (\(_, y) -> y == 9) $ A.assocs trailMap
in (trailGraph, startList, endList)
parseInput :: IO (A.Array (Int, Int) Int)
parseInput = do
contents <- lines <$> readFile "input/day10.txt"
let trailMap = A.listArray ((0, 0), (52, 52)) . map digitToInt $ concat contents
return trailMap
getTrailGraph :: A.Array Coords Int -> (Graph Coords, [Coords], [Coords])
getTrailGraph trailMap =
let trailGraph = Graph {edges = M.fromList [(k, adjacent trailMap k (52, 52)) | k <- A.indices trailMap]}
startList = map fst . filter (\(_, y) -> y == 0) $ A.assocs trailMap
endList = map fst . filter (\(_, y) -> y == 9) $ A.assocs trailMap
in (trailGraph, startList, endList)
day10_1 :: IO ()
day10_1 = do
trailMap <- parseInput

55
src/Day16.hs Normal file
View File

@ -0,0 +1,55 @@
{-# LANGUAGE DeriveGeneric #-}
{-# OPTIONS_GHC -Wno-incomplete-patterns -Wno-type-defaults #-}
module Day16 (day16_1) where
import qualified Data.Array as A
import qualified Data.HashMap.Strict as M
import Data.Hashable
import Data.Ix
import GHC.Generics (Generic)
import Graph
data Direction = N | S | E | W deriving (Eq, Ord, Generic, Ix)
instance Hashable Direction
type Coords = (Int, Int, Direction)
getCost :: Direction -> Direction -> Int
getCost a b
| a == b = 1
| otherwise = 1000
adjacent :: A.Array Coords Char -> Coords -> (Int, Int) -> [(Coords, Distance Int)]
adjacent array (i, j, N) (maxI, maxJ) =
[((a, b, d), Dist (getCost N d)) | i >= 0, j >= 0, i <= maxI, j <= maxJ, (a, b, d) <- [(i - 1, j, N), (i, j, W), (i, j, E)], array A.! (i, j, d) /= '#']
adjacent array (i, j, S) (maxI, maxJ) =
[((a, b, d), Dist (getCost S d)) | i >= 0, j >= 0, i <= maxI, j <= maxJ, (a, b, d) <- [(i + 1, j, S), (i, j, W), (i, j, E)], array A.! (i, j, d) /= '#']
adjacent array (i, j, E) (maxI, maxJ) =
[((a, b, d), Dist (getCost E d)) | i >= 0, j >= 0, i <= maxI, j <= maxJ, (a, b, d) <- [(i, j + 1, E), (i, j, N), (i, j, S)], array A.! (i, j, d) /= '#']
adjacent array (i, j, W) (maxI, maxJ) =
[((a, b, d), Dist (getCost W d)) | i >= 0, j >= 0, i <= maxI, j <= maxJ, (a, b, d) <- [(i, j - 1, W), (i, j, N), (i, j, S)], array A.! (i, j, d) /= '#']
getMazeGraph :: A.Array Coords Char -> Int -> Int -> (Graph Coords Int, Coords, [Coords])
getMazeGraph mazeMap nRow nCol =
let mazeGraph = Graph {edges = M.fromList [(k, adjacent mazeMap k (nRow, nCol)) | k <- A.indices mazeMap]}
start = fst . last . filter (\((_, _, d), c) -> d == E && c == 'S') $ A.assocs mazeMap
end = map fst $ filter (\(_, c) -> c == 'E') $ A.assocs mazeMap
in (mazeGraph, start, end)
parseInput :: IO (A.Array (Int, Int, Direction) Char, Int, Int)
parseInput = do
contents <- lines <$> readFile "input/day16.txt"
let nRow = length contents - 1
nCol = length (last contents) - 1
mazeMap = A.listArray ((0, 0, N), (nRow, nCol, W)) (concatMap (replicate 4) $ concat contents)
return (mazeMap, nRow, nCol)
day16_1 :: IO ()
day16_1 = do
(mazeMap, nRow, nCol) <- parseInput
let (mazeGraph, start, end) = getMazeGraph mazeMap nRow nCol
shortestPaths = [findShortestPath mazeGraph start e | e <- end]
-- putStrLn $ "Day 16, Puzzle 1 solution: " ++ show (findShortestPath mazeGraph start end)
putStrLn $ "Day 16, Puzzle 1 solution: " ++ show (minimum shortestPaths)

6
src/Day18.hs
View File

@ -13,8 +13,8 @@ import Graph
type Coords = (Int, Int)
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) /= '#']
adjacent :: (Num a) => A.Array Coords Char -> Coords -> Coords -> [(Coords, Distance a)]
adjacent array (i, j) (maxI, maxJ) = [((a, b), Dist 1) | (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) /= '#']
corruptMemory :: A.Array Coords Char -> [Coords] -> A.Array Coords Char
corruptMemory = foldl (\a b -> a A.// [(b, '#')])
@ -32,7 +32,7 @@ getCorruptedMemoryMap fallingBytes =
let memory = A.listArray ((0, 0), (70, 70)) $ replicate 5041 '.'
bytesCoords = take 1024 [(read x, read y) | (x : y : _) <- fallingBytes]
corruptedMemory = corruptMemory memory bytesCoords
in corruptedMemory
in corruptedMemory
day18_1 :: IO ()
day18_1 = do

21
src/Graph.hs
View File

@ -10,8 +10,6 @@ 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
@ -24,6 +22,8 @@ instance (Show a) => Show (Distance a) where
show Infinity = "Infinity"
show (Dist x) = show x
newtype Graph a b = Graph {edges :: M.HashMap a [(a, Distance b)]} deriving (Show)
addDistance :: (Num a) => Distance a -> Distance a -> Distance a
addDistance (Dist x) (Dist y) = Dist (x + y)
addDistance _ _ = Infinity
@ -33,23 +33,26 @@ data DijkstraState a b = DijkstraState
distances :: M.HashMap a (Distance b)
}
updateDistances :: (Hashable a) => M.HashMap a (Distance b) -> [a] -> Distance b -> M.HashMap a (Distance b)
updateDistances :: (Hashable a, Num b) => M.HashMap a (Distance b) -> [(a, Distance b)] -> Distance b -> M.HashMap a (Distance b)
updateDistances dists [] _ = dists
updateDistances dists (n : nodes) startD =
updateDistances (M.adjust (const startD) n dists) nodes startD
let newD = addDistance startD (snd n)
in updateDistances (M.adjust (const newD) (fst n) dists) nodes startD
visit :: (Ord a, Ord b) => PQ.PSQ a (Distance b) -> a -> [a] -> Distance b -> PQ.PSQ a (Distance b)
visit :: (Ord a, Num b, Ord b) => PQ.PSQ a (Distance b) -> a -> [(a, Distance b)] -> 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
visit us node (e : es) startD =
let newD = addDistance startD (snd e)
in visit (PQ.adjust (const newD) (fst e) us) node es startD
visitNode :: (Hashable a, Ord a, Ord b) => DijkstraState a b -> Graph a -> a -> Distance b -> DijkstraState a b
visitNode :: (Hashable a, Ord a, Num b, Ord b) => DijkstraState a b -> Graph a b -> 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 :: (Hashable a, Ord a, Ord b, Num b) => Graph a b -> 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]
@ -65,4 +68,4 @@ findShortestPath graph start end =
else
if d == Infinity
then Infinity
else dijkstra $ visitNode s graph n (addDistance d (Dist 1))
else dijkstra $ visitNode s graph n d

2
src/Main.hs
View File

@ -15,6 +15,7 @@ import Day12 (day12_1)
import Day13 (day13_1, day13_2)
import Day14 (day14_1, day14_2)
import Day15 (day15_1)
import Day16 (day16_1)
import Day17 (day17_1, day17_2)
import Day18 (day18_1, day18_2)
import Day19 (day19_1)
@ -92,6 +93,7 @@ main = do
day14_1
day14_2
"15" : "1" : _ -> day15_1
"16" : "1" : _ -> day16_1
"17" : "1" : _ -> day17_1
"17" : "2" : _ -> day17_2
"17" : _ -> do