2023 day 8 part 1 in Haskell

2023/08/Day08.cabal

@@ -0,0 +1,19 @@
+cabal-version:   3.0
+name:            Day08
+version:         0.1.0.0
+license:         NONE
+build-type:      Simple
+extra-doc-files: CHANGELOG.md
+
+common warnings
+    ghc-options: -Wall
+
+executable Day08
+    import:           warnings
+    main-is:          Day08.hs
+    build-depends:    base ^>=4.17.2.1
+                    , attoparsec ^>=0.14.4
+                    , text ^>=2.1
+                    , containers ^>=0.6.7
+    hs-source-dirs:   .
+    default-language: Haskell2010

2023/08/Day08.hs

@@ -0,0 +1,62 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Main where
+
+import Data.Attoparsec.Text as A
+import Data.List (isSuffixOf)
+import Data.Map (Map, fromList, keys, (!))
+import qualified Data.Text as T
+import qualified Data.Text.IO as TIO
+
+type Address = [Char]
+
+type Addresses = Map Address (Address, Address)
+
+type Input = ([Char], Addresses)
+
+main :: IO ()
+main = do
+  input <- TIO.getContents >>= parseInput
+  putStrLn ("Part 1: " <> show (part1 input))
+  putStrLn ("Part 2: " <> show (part2 input))
+
+part1 :: Input -> Int
+part1 (p, m) = solution p m "AAA"
+
+part2 :: Input -> Int
+part2 (p, m) = foldl1 lcm $ map (solution p m) starts
+  where
+    starts = filter ("A" `isSuffixOf`) $ keys m
+
+solution :: [Char] -> Addresses -> Address -> Int
+solution p m start = fst $ head $ filter (done . snd) $ zip [0 ..] $ scanl (step m) start $ cycle p
+
+step :: Addresses -> Address -> Char -> Address
+step m src i = next
+  where
+    current = m ! src
+    next = case i of
+      'L' -> fst current
+      'R' -> snd current
+      _ -> error "The only expected instructions are 'L' and 'R'"
+
+done :: Address -> Bool
+done = ("Z" `isSuffixOf`)
+
+parseInput :: T.Text -> IO Input
+parseInput s = case parseOnly inputParser s of
+  Right i -> pure i
+  Left e -> error e
+
+inputParser :: Parser Input
+inputParser = do
+  instructions <- takeTill isEndOfLine <* endOfLine <* endOfLine
+  tree <- many1 lineParser <* endOfInput
+  return (T.unpack instructions, fromList tree)
+
+lineParser :: Parser (Address, (Address, Address))
+lineParser = do
+  src <- A.take 3 <* string " = ("
+  l <- A.take 3 <* string ", "
+  r <- A.take 3 <* string ")" <* endOfLine
+  return (T.unpack src, (T.unpack l, T.unpack r))

2023/08/example

@@ -0,0 +1,9 @@
+RL
+
+AAA = (BBB, CCC)
+BBB = (DDD, EEE)
+CCC = (ZZZ, GGG)
+DDD = (DDD, DDD)
+EEE = (EEE, EEE)
+GGG = (GGG, GGG)
+ZZZ = (ZZZ, ZZZ)

2023/08/example2

@@ -0,0 +1,5 @@
+LLR
+
+AAA = (BBB, BBB)
+BBB = (AAA, ZZZ)
+ZZZ = (ZZZ, ZZZ)

2023/08/example3

@@ -0,0 +1,10 @@
+LR
+
+11A = (11B, XXX)
+11B = (XXX, 11Z)
+11Z = (11B, XXX)
+22A = (22B, XXX)
+22B = (22C, 22C)
+22C = (22Z, 22Z)
+22Z = (22B, 22B)
+XXX = (XXX, XXX)