80 lines
1.8 KiB
Haskell
80 lines
1.8 KiB
Haskell
|
{-# LANGUAGE OverloadedStrings #-}
|
||
|
module Day08 (parse, solveA, solveB) where
|
||
|
|
||
|
import Data.Void (Void)
|
||
|
import Data.Text (Text)
|
||
|
import Data.Bifunctor (first)
|
||
|
import Text.Megaparsec (Parsec, errorBundlePretty, runParser, many, eof)
|
||
|
import Text.Megaparsec.Char (alphaNumChar, space, char)
|
||
|
|
||
|
|
||
|
data Dir = L | R
|
||
|
deriving (Show, Read)
|
||
|
|
||
|
type Node = (String, (String, String))
|
||
|
type Input = ([Dir], [Node])
|
||
|
|
||
|
type Parser = Parsec Void Text
|
||
|
|
||
|
|
||
|
parse :: Text -> Either String ([Dir], [Node])
|
||
|
parse = first errorBundlePretty . runParser input ""
|
||
|
where
|
||
|
node :: Parser Node
|
||
|
node = do
|
||
|
name <- many alphaNumChar
|
||
|
space
|
||
|
_ <- char '='
|
||
|
space
|
||
|
_ <- char '('
|
||
|
l <- many alphaNumChar
|
||
|
_ <- char ','
|
||
|
space
|
||
|
r <- many alphaNumChar
|
||
|
_ <- char ')'
|
||
|
space
|
||
|
return (name, (l, r))
|
||
|
input :: Parser ([Dir], [Node])
|
||
|
input = do
|
||
|
path <- map (read . pure) <$> many alphaNumChar
|
||
|
space
|
||
|
ns <- many node
|
||
|
eof
|
||
|
return (path, ns)
|
||
|
|
||
|
|
||
|
input :: Text
|
||
|
input =
|
||
|
"RL\n\
|
||
|
\\n\
|
||
|
\AAA = (BBB, CCC)\n\
|
||
|
\BBB = (DDD, EEE)\n\
|
||
|
\CCC = (ZZZ, GGG)\n\
|
||
|
\DDD = (DDD, DDD)\n\
|
||
|
\EEE = (EEE, EEE)\n\
|
||
|
\GGG = (GGG, GGG)\n\
|
||
|
\ZZZ = (ZZZ, ZZZ)\n"
|
||
|
|
||
|
|
||
|
run :: [Node] -> String -> [Dir] -> [(Int, String)]
|
||
|
run ns start = helper 0 start . cycle
|
||
|
where
|
||
|
get :: String -> (String, String)
|
||
|
get name = snd . head . filter ((name ==) . fst) $ ns
|
||
|
helper :: Int -> String -> [Dir] -> [(Int, String)]
|
||
|
helper i curr dir = (i, curr) : helper (succ i) (move $ get curr) (tail dir)
|
||
|
where
|
||
|
move = case head dir of
|
||
|
L -> fst
|
||
|
R -> snd
|
||
|
|
||
|
solveA :: Input -> Int
|
||
|
solveA (ds, ns) = fst . head . filter (("ZZZ" ==) . snd) $ run ns "AAA" ds
|
||
|
|
||
|
solveB :: Input -> Int
|
||
|
solveB = const 1
|
||
|
|
||
|
-- >>> solveA <$> parse input
|
||
|
-- Right 2
|
||
|
|