Day 10, Part 2 + rewrite Part 1

adventofcode2024.cabal

@@ -56,6 +56,7 @@ executable adventofcode2024
     Day09.Puzzle1
     Day09.Puzzle2
     Day10.Puzzle1
+    Day10.Puzzle2
     Day11.Puzzle1
     Day11.Puzzle2
     Day12.Puzzle1

src/Day10/Puzzle1.hs

@@ -1,37 +1,29 @@
 module Day10.Puzzle1 (day10_1) where
 
+import qualified Data.Array as A
 import Data.Char (digitToInt)
-import Data.Graph (graphFromEdges, path, vertices)
+import qualified Data.HashMap.Strict as M
-import Data.List (uncons)
-import Data.List.Split (chunksOf)
-import Data.Maybe (fromJust)
 
 type Coords = (Int, Int)
 
-type V = (String, Int)
+newtype Graph a = Graph {edges :: M.HashMap a [a]} deriving (Show)
 
-getValue :: [[V]] -> Coords -> V
+adjacent :: A.Array Coords Int -> Coords -> Coords -> [Coords]
-getValue grid (i, j) = grid !! i !! j
+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]
 
-getEdges :: [[V]] -> Coords -> [Int]
+findAllPaths :: Graph Coords -> Coords -> Coords -> [Coords] -> [[Coords]]
-getEdges grid (i, j) =
+findAllPaths graph start end path = do
-  let value = fst $ grid !! i !! j
+  node <- edges graph M.! start
-      adjI = filter (\x -> fst x >= 0 && fst x < length grid && snd x >= 0 && snd x < length (fst . fromJust $ uncons grid)) [(i, j + 1), (i + 1, j), (i, j - 1), (i - 1, j)]
+  let path' = path ++ [node]
-   in [snd x | x <- map (getValue grid) adjI, digitToInt (fst . fromJust $ uncons value) == digitToInt (fst . fromJust $ uncons (fst x)) - 1]
+  if node == end
-
+    then return path'
-listVertices :: [String] -> [[V]]
+    else findAllPaths graph node end path'
-listVertices grid =
-  let l = length $ fst . fromJust $ uncons grid
-   in chunksOf l $ zip (map (: []) (concat grid)) [0 ..]
 
 day10_1 :: IO ()
 day10_1 = do
   contents <- lines <$> readFile "input/day10.txt"
-  let grid = listVertices contents
+  let trailMap = A.listArray ((0, 0), (52, 52)) $ map digitToInt $ concat contents
-      edgeCoords = [(x, y) | x <- [0 .. length grid - 1], y <- [0 .. length (fst . fromJust $ uncons grid) - 1]]
+      trailGraph = Graph {edges = M.fromList [(k, adjacent trailMap k (52, 52)) | k <- A.indices trailMap]}
-      edgeList = [(x, y, z) | ((x, y), z) <- zip (concat grid) (map (getEdges grid) edgeCoords)]
+      startList = map fst . filter (\(_, y) -> y == 0) $ A.assocs trailMap
-      (graph, nodeFromVertex, _) = graphFromEdges edgeList
+      endList = map fst . filter (\(_, y) -> y == 9) $ A.assocs trailMap
-      startList = [x | (_, x, _) <- filter (\(x, _, _) -> x == "0") $ map nodeFromVertex $ vertices graph]
+  putStrLn $ "Day 10, Puzzle 1 solution: " ++ show (length $ filter (not . null) [findAllPaths trailGraph x y [x] | x <- startList, y <- endList])
-      endList = [x | (_, x, _) <- filter (\(x, _, _) -> x == "9") $ map nodeFromVertex $ vertices graph]
-      paths = filter id $ [path graph x y | x <- startList, y <- endList]
-  putStrLn $ "Day 10, Puzzle 1 solution: " ++ show (length paths)

src/Day10/Puzzle2.hs

@@ -0,0 +1,30 @@
+module Day10.Puzzle2 (day10_2) where
+
+import qualified Data.Array as A
+import Data.Char (digitToInt)
+import qualified Data.HashMap.Strict as M
+
+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]
+
+findAllPaths :: Graph Coords -> Coords -> Coords -> [Coords] -> [[Coords]]
+findAllPaths graph start end path = do
+  node <- edges graph M.! start
+  let path' = path ++ [node]
+  if node == end
+    then return path'
+    else findAllPaths graph node end path'
+
+day10_2 :: IO ()
+day10_2 = do
+  contents <- lines <$> readFile "input/day10.txt"
+  let trailMap = A.listArray ((0, 0), (52, 52)) $ map digitToInt $ concat contents
+      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
+      paths = concat $ filter (not . null) [findAllPaths trailGraph x y [x] | x <- startList, y <- endList]
+  putStrLn $ "Day 10, Puzzle 2 solution: " ++ show (length paths)

src/Main.hs

@@ -19,6 +19,7 @@ import Day08.Puzzle2
 import Day09.Puzzle1
 import Day09.Puzzle2
 import Day10.Puzzle1
+import Day10.Puzzle2
 import Day11.Puzzle1
 import Day11.Puzzle2
 import Day12.Puzzle1
@@ -56,6 +57,7 @@ main = do
     "9" : "1" : _ -> day09_1
     "9" : "2" : _ -> day09_2
     "10" : "1" : _ -> day10_1
+    "10" : "2" : _ -> day10_2
     "11" : "1" : _ -> day11_1
     "11" : "2" : _ -> day11_2
     "12" : "1" : _ -> day12_1