diff --git a/README.md b/README.md index 439b41a..1af4561 100644 --- a/README.md +++ b/README.md @@ -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 | | diff --git a/adventofcode2024.cabal b/adventofcode2024.cabal index 0ae47bb..83f44d2 100644 --- a/adventofcode2024.cabal +++ b/adventofcode2024.cabal @@ -53,6 +53,7 @@ executable adventofcode2024 Day13 Day14 Day15 + Day16 Day17 Day18 Day19 diff --git a/src/Day10.hs b/src/Day10.hs index 6f1528b..95780c3 100644 --- a/src/Day10.hs +++ b/src/Day10.hs @@ -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 diff --git a/src/Day16.hs b/src/Day16.hs new file mode 100644 index 0000000..3cc2db9 --- /dev/null +++ b/src/Day16.hs @@ -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) diff --git a/src/Day18.hs b/src/Day18.hs index 1493854..6abee52 100644 --- a/src/Day18.hs +++ b/src/Day18.hs @@ -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 diff --git a/src/Graph.hs b/src/Graph.hs index aef77c1..58f2447 100644 --- a/src/Graph.hs +++ b/src/Graph.hs @@ -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 diff --git a/src/Main.hs b/src/Main.hs index b314b39..12062d1 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -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