From 93e7ffc42fbcf8df21e00e82fcd6b94a5d14cab2 Mon Sep 17 00:00:00 2001 From: Nathan McCarty Date: Mon, 5 Dec 2022 16:29:26 -0500 Subject: [PATCH] Day 5 Part 2 --- 05/Main.idr | 36 +++++++++++++++++++++++------------- 1 file changed, 23 insertions(+), 13 deletions(-) diff --git a/05/Main.idr b/05/Main.idr index cdc6454..7610c93 100644 --- a/05/Main.idr +++ b/05/Main.idr @@ -58,6 +58,10 @@ parseStacks k (x :: xs) = let (Stks bottom) = parseStacks k xs parseStacksHelper (Just crate) xs = crate :: 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 = """ [D] @@ -85,10 +89,10 @@ parseCommand str = _ => Nothing -- Apply a command to the stacks -applyCommand : Command -> Stacks -> Maybe Stacks -applyCommand (Cmd count from to) stacks = +applyCommand : Command -> Bool -> Stacks -> Maybe Stacks +applyCommand (Cmd count from to) multiple 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) extractCrates count from (Stks []) = Nothing extractCrates count 0 (Stks (x :: xs)) = @@ -113,11 +117,11 @@ Show CmdResult where unlines ["Command applied: " ++ (show bool), "Command: " ++ (show command), show stacks] -- Apply a list of commands to a stacks -applyCommands : List Command -> Stacks -> List CmdResult -applyCommands [] x = [CR False Nothing x] -applyCommands (y :: xs) x = - case applyCommand y x of - Just stacks => CR True (Just y) stacks :: applyCommands xs stacks +applyCommands : List Command -> Bool -> Stacks -> List CmdResult +applyCommands [] multiple x = [CR False Nothing x] +applyCommands (y :: xs) multiple x = + case applyCommand y multiple x of + Just stacks => CR True (Just y) stacks :: applyCommands xs multiple stacks Nothing => [CR False (Just y) x] mapM : Monad m => (a -> m b) -> List a -> m (List b) @@ -127,17 +131,23 @@ mapM f (x :: xs) = rest <- mapM f xs pure $ x :: rest -main : IO () +partial unwrap : Maybe a -> a +unwrap (Just x) = x + +partial main : IO () main = do file <- readFile "input" case file of Right content => let stacks = parseStacks 9 . takeWhile (/= "") . 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: " printLn stacks - putStrLn "" - _ <- mapM printLn result - pure () + putStrLn " " + putStr "Part 1: " + putStrLn part1 + putStr "Part 2: " + putStrLn part2 Left err => printLn err