From d62259bf75b2f36d9c27d1bae10b28b141e5a3c7 Mon Sep 17 00:00:00 2001 From: Jens Kadenbach Date: Mon, 5 Dec 2022 15:59:01 +0100 Subject: [PATCH] Day 5 Part 2 --- aoc2022.cabal | 2 ++ src/Day5.hs | 3 ++ src/Day5/Part1.hs | 81 ++------------------------------------------ src/Day5/Part2.hs | 24 +++++++++++++ src/Day5/Shared.hs | 84 ++++++++++++++++++++++++++++++++++++++++++++++ test/Day5Spec.hs | 9 +++++ 6 files changed, 124 insertions(+), 79 deletions(-) create mode 100644 src/Day5/Part2.hs create mode 100644 src/Day5/Shared.hs diff --git a/aoc2022.cabal b/aoc2022.cabal index 107c9ed..612dbe5 100644 --- a/aoc2022.cabal +++ b/aoc2022.cabal @@ -41,6 +41,8 @@ library Day4.Shared Day5 Day5.Part1 + Day5.Part2 + Day5.Shared Lib other-modules: Paths_aoc2022 diff --git a/src/Day5.hs b/src/Day5.hs index 3766bff..21f498e 100644 --- a/src/Day5.hs +++ b/src/Day5.hs @@ -1,6 +1,7 @@ module Day5 (day5) where import Day5.Part1 +import Day5.Part2 day5 :: IO () @@ -9,3 +10,5 @@ day5 = do putStrLn "Day5" let message = day5_1 input putStrLn ("Message from crates: " ++ message) + let secondMessage = day5_2 input + putStrLn ("Actuale message from crates: " ++ secondMessage) diff --git a/src/Day5/Part1.hs b/src/Day5/Part1.hs index 81b78bb..660d917 100644 --- a/src/Day5/Part1.hs +++ b/src/Day5/Part1.hs @@ -1,82 +1,11 @@ module Day5.Part1 ( - StackIndex (..), - Operation (..), - Stack (..), - parseOperation, - parseStacks, - parseRow, - combineRows, - parseInput, executeOperation, - zipWithPadding, - findTopOfStacks, day5_1 ) where import qualified Data.Sequence as S -import Data.Sequence (Seq (..)) import Data.Foldable (toList) - -newtype StackIndex = StackIndex Int deriving (Show, Eq, Ord) -asInt :: StackIndex -> Int -asInt (StackIndex i) = i - 1 - -data Operation = Operation - { count :: Int - , from :: StackIndex - , to :: StackIndex} deriving (Show, Eq) - -type Content = Char -newtype Stack = Stack [Content] deriving (Show, Eq) - -content :: Stack -> [Content] -content (Stack c) = c - -instance Semigroup Stack where - (Stack x) <> (Stack y) = Stack (x ++ y) - -instance Monoid Stack where - mempty = Stack [] - -type Row = S.Seq Stack - -parseOperation :: String -> Operation -parseOperation line = Operation { - count = read $ parts !! 1, - from = StackIndex (read $ parts !! 3), - to = StackIndex (read $ parts !! 5) - } - where - parts = words line - -parseStacks :: [String] -> Row -parseStacks input = foldl combineRows S.empty rows - where - rows = map parseRow input - -parseRow :: String -> Row -parseRow ('[':c:']':' ':cs) = Stack [c] :<| parseRow cs -parseRow (' ':' ':' ':' ':cs) = Stack [] :<| parseRow cs -parseRow ['[', c, ']'] = S.singleton $ Stack [c] -parseRow [' ', ' ', ' '] = S.singleton $ Stack [] -parseRow (' ':'1':_) = S.empty -- skip last line -parseRow cs = error ("parseRow: unexpected Row \"" ++ cs ++ "\"") - -combineRows :: Row -> Row -> Row -combineRows S.Empty row = row -combineRows row S.Empty = row -combineRows up down = S.fromList [x <> y | (x,y) <- zipWithPadding up down] - -zipWithPadding :: (Monoid a, Monoid b) => S.Seq a -> S.Seq b -> [(a,b)] -zipWithPadding (x :<| xs) (y :<| ys) = (x,y) : zipWithPadding xs ys -zipWithPadding S.Empty (y :<| ys) = (mempty, y) : zipWithPadding S.empty ys -zipWithPadding (x :<| xs) S.Empty = (x, mempty) : zipWithPadding xs S.empty -zipWithPadding S.Empty S.Empty = [] - -parseInput :: String -> (Row, [Operation]) -parseInput input = (parseStacks stackInput, map parseOperation (drop 1 operationInput)) - where - (stackInput, operationInput) = break ("" ==) $ lines input +import Day5.Shared executeOperation :: Row -> Operation -> Row executeOperation row op @@ -90,13 +19,7 @@ executeOperation row op updatedTarget = Stack (movedContent : content targetStack) updatedRow = S.update (asInt $ to op) updatedTarget $ S.update (asInt $ from op) updatedOrigin row -findTopOfStacks :: Row -> Seq Content -findTopOfStacks row = head . content <$> row - -executeAllOperations :: Row -> [Operation] -> Row -executeAllOperations = foldl executeOperation - day5_1 :: String -> String -day5_1 input = toList . findTopOfStacks $ executeAllOperations row operations +day5_1 input = toList . findTopOfStacks $ foldl executeOperation row operations where (row, operations) = parseInput input diff --git a/src/Day5/Part2.hs b/src/Day5/Part2.hs new file mode 100644 index 0000000..0286706 --- /dev/null +++ b/src/Day5/Part2.hs @@ -0,0 +1,24 @@ +module Day5.Part2 ( + execute9001Operation, + day5_2 +) where + +import qualified Data.Sequence as S +import Data.Foldable (toList) +import Day5.Shared + +execute9001Operation :: Row -> Operation -> Row +execute9001Operation row op + = updatedRow + where + originStack = row `S.index` asInt (from op) + targetStack = row `S.index` asInt (to op) + movedContent = take (count op) $ content originStack + updatedOrigin = Stack (drop (count op) $ content originStack) + updatedTarget = Stack (movedContent ++ content targetStack) + updatedRow = S.update (asInt $ to op) updatedTarget $ S.update (asInt $ from op) updatedOrigin row + +day5_2 :: String -> String +day5_2 input = toList . findTopOfStacks $ foldl execute9001Operation row operations + where + (row, operations) = parseInput input diff --git a/src/Day5/Shared.hs b/src/Day5/Shared.hs new file mode 100644 index 0000000..e0dd6bf --- /dev/null +++ b/src/Day5/Shared.hs @@ -0,0 +1,84 @@ +module Day5.Shared ( + StackIndex (..), + Operation (..), + Stack (..), + Row, + Content, + asInt, + content, + parseOperation, + parseStacks, + parseRow, + combineRows, + parseInput, + zipWithPadding, + findTopOfStacks +) where + +import qualified Data.Sequence as S +import Data.Sequence (Seq (..)) + +newtype StackIndex = StackIndex Int deriving (Show, Eq, Ord) +asInt :: StackIndex -> Int +asInt (StackIndex i) = i - 1 + +data Operation = Operation + { count :: Int + , from :: StackIndex + , to :: StackIndex} deriving (Show, Eq) + +type Content = Char +newtype Stack = Stack [Content] deriving (Show, Eq) + +content :: Stack -> [Content] +content (Stack c) = c + +instance Semigroup Stack where + (Stack x) <> (Stack y) = Stack (x ++ y) + +instance Monoid Stack where + mempty = Stack [] + +type Row = S.Seq Stack + +parseOperation :: String -> Operation +parseOperation line = Operation { + count = read $ parts !! 1, + from = StackIndex (read $ parts !! 3), + to = StackIndex (read $ parts !! 5) + } + where + parts = words line + +parseStacks :: [String] -> Row +parseStacks input = foldl combineRows S.empty rows + where + rows = map parseRow input + +parseRow :: String -> Row +parseRow ('[':c:']':' ':cs) = Stack [c] :<| parseRow cs +parseRow (' ':' ':' ':' ':cs) = Stack [] :<| parseRow cs +parseRow ['[', c, ']'] = S.singleton $ Stack [c] +parseRow [' ', ' ', ' '] = S.singleton $ Stack [] +parseRow (' ':'1':_) = S.empty -- skip last line +parseRow cs = error ("parseRow: unexpected Row \"" ++ cs ++ "\"") + +combineRows :: Row -> Row -> Row +combineRows S.Empty row = row +combineRows row S.Empty = row +combineRows up down = S.fromList [x <> y | (x,y) <- zipWithPadding up down] + +zipWithPadding :: (Monoid a, Monoid b) => S.Seq a -> S.Seq b -> [(a,b)] +zipWithPadding (x :<| xs) (y :<| ys) = (x,y) : zipWithPadding xs ys +zipWithPadding S.Empty (y :<| ys) = (mempty, y) : zipWithPadding S.empty ys +zipWithPadding (x :<| xs) S.Empty = (x, mempty) : zipWithPadding xs S.empty +zipWithPadding S.Empty S.Empty = [] + +parseInput :: String -> (Row, [Operation]) +parseInput input = (parseStacks stackInput, map parseOperation (drop 1 operationInput)) + where + (stackInput, operationInput) = break ("" ==) $ lines input + + +findTopOfStacks :: Row -> Seq Content +findTopOfStacks row = head . content <$> row diff --git a/test/Day5Spec.hs b/test/Day5Spec.hs index 116f768..578890d 100644 --- a/test/Day5Spec.hs +++ b/test/Day5Spec.hs @@ -6,6 +6,8 @@ import Text.Heredoc import qualified Data.Sequence as S import Day5.Part1 +import Day5.Part2 +import Day5.Shared inputPart1 :: String inputPart1 = [str| [D] @@ -72,4 +74,11 @@ spec = findTopOfStacks row `shouldBe` S.fromList "NDP" it "solves the demo" $ do day5_1 inputPart1 `shouldBe` "CMZ" + describe "Part1" $ do + it "executes 9001 operations on a row" $ do + let op = Operation { count = 2, from = StackIndex 2, to = StackIndex 3} + let row = S.fromList [Stack "NZ", Stack "DCM", Stack "P"] + execute9001Operation row op `shouldBe` S.fromList [Stack "NZ", Stack "M", Stack "DCP"] + it "solves the demo" $ do + day5_2 inputPart1 `shouldBe` "MCD"