aoc
/
2022
1
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Day 5 Part 2

This commit is contained in:
Nathan McCarty 2022-12-05 16:29:26 -05:00
parent 48e406c690
commit 93e7ffc42f
Signed by: thatonelutenist
GPG Key ID: D70DA3DD4D1E9F96
1 changed files with 23 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
05/Main.idr
View File

@ -58,6 +58,10 @@ parseStacks k (x :: xs) = let (Stks bottom) = parseStacks k xs
parseStacksHelper (Just crate) xs = crate :: xs parseStacksHelper (Just crate) xs = crate :: xs
parseStacksHelper Nothing xs = xs parseStacksHelper Nothing xs = xs
-- Get the tops of each stack
tops : Stacks -> String
tops (Stks xss) = pack . map (\(C c) => c) . catMaybes . map head' $ xss
simple : String simple : String
simple = """ simple = """
[D] [D]
@ -85,10 +89,10 @@ parseCommand str =
_ => Nothing _ => Nothing
-- Apply a command to the stacks -- Apply a command to the stacks
applyCommand : Command -> Stacks -> Maybe Stacks applyCommand : Command -> Bool -> Stacks -> Maybe Stacks
applyCommand (Cmd count from to) stacks = applyCommand (Cmd count from to) multiple stacks =
do (crates, removed) <- extractCrates count from stacks do (crates, removed) <- extractCrates count from stacks
addCrates (reverse crates) to removed addCrates (if multiple then crates else reverse crates) to removed
where extractCrates : Nat -> Nat -> Stacks -> Maybe ((List Crate), Stacks) where extractCrates : Nat -> Nat -> Stacks -> Maybe ((List Crate), Stacks)
extractCrates count from (Stks []) = Nothing extractCrates count from (Stks []) = Nothing
extractCrates count 0 (Stks (x :: xs)) = extractCrates count 0 (Stks (x :: xs)) =
@ -113,11 +117,11 @@ Show CmdResult where
unlines ["Command applied: " ++ (show bool), "Command: " ++ (show command), show stacks] unlines ["Command applied: " ++ (show bool), "Command: " ++ (show command), show stacks]
-- Apply a list of commands to a stacks -- Apply a list of commands to a stacks
applyCommands : List Command -> Stacks -> List CmdResult applyCommands : List Command -> Bool -> Stacks -> List CmdResult
applyCommands [] x = [CR False Nothing x] applyCommands [] multiple x = [CR False Nothing x]
applyCommands (y :: xs) x = applyCommands (y :: xs) multiple x =
case applyCommand y x of case applyCommand y multiple x of
Just stacks => CR True (Just y) stacks :: applyCommands xs stacks Just stacks => CR True (Just y) stacks :: applyCommands xs multiple stacks
Nothing => [CR False (Just y) x] Nothing => [CR False (Just y) x]
mapM : Monad m => (a -> m b) -> List a -> m (List b) mapM : Monad m => (a -> m b) -> List a -> m (List b)
@ -127,17 +131,23 @@ mapM f (x :: xs) =
rest <- mapM f xs rest <- mapM f xs
pure $ x :: rest pure $ x :: rest
main : IO () partial unwrap : Maybe a -> a
unwrap (Just x) = x
partial main : IO ()
main = main =
do file <- readFile "input" do file <- readFile "input"
case file of case file of
Right content => Right content =>
let stacks = parseStacks 9 . takeWhile (/= "") . lines $ content let stacks = parseStacks 9 . takeWhile (/= "") . lines $ content
commands = catMaybes . map parseCommand . drop 1 . dropWhile (/= "") . lines $ content commands = catMaybes . map parseCommand . drop 1 . dropWhile (/= "") . lines $ content
result = applyCommands commands stacks part1 = unwrap . map (\(CR _ _ stacks) => tops stacks) . last' . applyCommands commands False $ stacks
part2 = unwrap . map (\(CR _ _ stacks) => tops stacks) . last' . applyCommands commands True $ stacks
in do putStrLn "Input: " in do putStrLn "Input: "
printLn stacks printLn stacks
putStrLn "" putStrLn " "
_ <- mapM printLn result putStr "Part 1: "
pure () putStrLn part1
putStr "Part 2: "
putStrLn part2
Left err => printLn err Left err => printLn err