Day 8

advent-of-code-2023.cabal

@@ -60,3 +60,11 @@ executable day07
     build-depends:    base ^>=4.15.1.0, MissingH
     hs-source-dirs:   day07
     default-language: Haskell2010
+
+executable day08
+    main-is:          Main.hs
+    other-modules:    Commons Part1 Part2
+
+    build-depends:    base ^>=4.15.1.0, hashable, unordered-containers
+    hs-source-dirs:   day08
+    default-language: Haskell2010

day08/Commons.hs

@@ -0,0 +1,40 @@
+module Commons where
+
+import GHC.IO.Handle (isEOF)
+import Data.Hashable (Hashable (hash), hashWithSalt)
+import Data.HashMap.Strict (HashMap, empty, insert, singleton, union)
+
+
+data Instruction = ILeft | IRight deriving Eq
+instance Hashable Instruction where
+  hashWithSalt s ILeft = s + hash False
+  hashWithSalt s IRight = s + hash True
+
+data Network = Network { instructions :: [Instruction], nodes :: HashMap (String, Instruction) String }
+
+
+parseInstructions :: String -> [Instruction]
+parseInstructions ('L': t) = ILeft: parseInstructions t
+parseInstructions ('R': t) = IRight: parseInstructions t
+parseInstructions [] = []
+
+parseNode :: String -> HashMap (String, Instruction) String
+parseNode [a, b, c, ' ', '=', ' ', '(', d, e, f, ',', ' ', g, h, i, ')'] =
+  insert ([a, b, c], ILeft) [d, e, f] $ singleton ([a, b, c], IRight) [g, h, i]
+
+parseNodes :: IO (HashMap (String, Instruction) String)
+parseNodes = do done <- isEOF
+                if done
+                   then return empty
+                   else do line <- getLine
+                           let node = parseNode line
+                           otherNodes <- parseNodes
+                           let newNodes = node `union` otherNodes
+                           return newNodes
+
+parse :: IO Network
+parse = do instructionsRaw <- getLine
+           getLine
+           let instructions = parseInstructions instructionsRaw
+           nodes <- parseNodes
+           return Network {instructions = instructions, nodes = nodes}

day08/Main.hs

@@ -0,0 +1,12 @@
+module Main where
+
+import Commons
+import qualified Part1
+import qualified Part2
+
+
+main = do network <- parse
+          let part1Res = Part1.getDistanceToEnd network
+          print part1Res
+          let part2Res = Part2.getSteps network
+          print part2Res

day08/Part1.hs

@@ -0,0 +1,13 @@
+module Part1 where
+
+import Commons
+import Data.HashMap.Strict ((!))
+
+
+getDistance :: String -> String -> [Instruction] -> Network -> Int
+getDistance start end [] network = getDistance start end (instructions network) network
+getDistance start end (ih: t) network | start == end = 0
+                                      | otherwise    = 1 + getDistance (nodes network ! (start, ih)) end t network
+
+getDistanceToEnd :: Network -> Int
+getDistanceToEnd = getDistance "AAA" "ZZZ" []

day08/Part2.hs

@@ -0,0 +1,21 @@
+module Part2 where
+
+import Commons
+import Data.HashMap.Internal.Strict (keys, (!))
+
+
+getStarts :: [(String, Instruction)] -> [String]
+getStarts [] = []
+getStarts (([a, b, 'A'], ILeft): t) = [a, b, 'A']: getStarts t
+getStarts (_: t) = getStarts t
+
+getDistanceToEnd :: [Instruction] -> Network -> String -> Int
+getDistanceToEnd [] network start = getDistanceToEnd (instructions network) network start
+getDistanceToEnd  _ _ [_, _, 'Z'] = 0
+getDistanceToEnd (ih: t) network start = 1 + getDistanceToEnd t network (nodes network ! (start, ih))
+
+getAllDistances :: Network -> [Int]
+getAllDistances network = map (getDistanceToEnd [] network) . getStarts . keys $ nodes network
+
+getSteps :: Network -> Int
+getSteps = foldr lcm 1 . getAllDistances