Advent of Code 2022 - Day 5: Supply Stacks
It's Day 5, and it's time to move some crates. We're given 9 initial stacks of crates, and instructions for how a crane moves crates from one stack to another. Here is our sample input:
[D]
[N] [C]
[Z] [M] [P]
1 2 3
move 1 from 2 to 1
move 3 from 1 to 3
move 2 from 2 to 1
move 1 from 1 to 2Initial thought: There's no way I'm parsing that stack diagram!
Parsing Moves
Based on parsing tricks I've learned recently, parsing the move instructions is straightforward:
data Move = Move Int Int Int
parseMove :: GenParser Char u Move
parseMove =
liftA3
Move
(string "move " >> parseInt)
(string " from " >> parseInt)
(string " to " >> parseInt)
-- parseInt now lives in my reusable Input module:
parseInt :: GenParser Char u Int
parseInt = read <$> many1 digitModeling the Stacks
Lists are a great way to represent stacks in just about any functional language like Haskell, since you can push and pop the top of the list while the tail remains unmodified. But how will we represent our set of 9 stacks? For that, I opted for an array. Compared to Lists, Arrays in Haskell are fixed size and provide faster access and updates to indexed elements. We will be looking up individual stacks and modifying them for each move instruction, so this is perfect for our needs.
Like I said, I wasn't going to parse that initial structure. Here is my input, hardcoded as an array. The start of each string is the top of each stack.
stacks :: Array Int String
stacks =
listArray
(1, 9)
[ "BVWTQNHD",
"BWD",
"CJWQST",
"PTZNRJF",
"TSMJVPG",
"NTFWB",
"NVHFQDLB",
"RFPH",
"HPNLBMSZ"
]Haskell sidesteps the debate about 0-based and 1-based indexing, as you need to specify the index range explicitly! Here, our stacks start at 1, so we use 1-9 instead of 0-8.
Applying Moves to Our Stack
Now all we have to do is fold our list of Moves onto our Array. Part 1 is actually a little trickier than Part 2 here, as we can only move one item at a time. If we're moving more than one item, let's just move one and then recurse.
move :: Array Int String -> Move -> Array Int String
move a (Move 0 _ _) = a
move a (Move n x y) =
let (h, rest) = splitAt 1 (a ! x)
in move (a // [(x, rest), (y, h ++ (a ! y))]) (Move (n - 1) x y)(a ! x) accesses the array element at index `x`. This code splits that element into the top item and the rest. It uses (a // assocs) to update the elements at the old and new index. Then it continues on, moving the next crate until the move is complete.
Part 2 is simpler, as we can move them all in one go:
moveAll :: Array Int String -> Move -> Array Int String
moveAll a (Move n x y) =
let (pickedUp, rest) = splitAt n (a ! x)
in a // [(x, rest), (y, pickedUp ++ (a ! y))]Finally, we need to take the top item from each stack and concatenate them into a string:
peekStacks :: Array Int String -> String
peekStacks = fmap head . elems
part1 :: [Move] -> String
part1 = peekStacks . foldl move stacks
part2 :: [Move] -> String
part2 = peekStacks . foldl moveAll stacksIs Parsing Really So Bad?
I solved this last night. When I woke up, I was refreshed and really didn't want to let this input get the best of me. How might we parse these stacks? Here's the plan:
- Parse each row one by one.
- Rows are either
"[A]"or"\s\s\s", separated by spaces. In either case, grab the middle character. - After we parse all rows, transpose them to get our stacks, filtering out any blank spaces.
Here is how that ended up looking:
parseStacks :: GenParser Char u [String]
parseStacks = fmap catMaybes . transpose <$> parseLines
where
parseCrate = find isLetter . Just <$> (oneOf "[ " *> anyChar <* oneOf " ]")
parseLine = parseCrate `sepBy1` char ' '
parseLines = parseLine `endBy1` newlineI stopped here. It should be trivial to parse this from the input file, and then parse the rest of the moves afterwards. We'll also need to convert our list of Strings into an Array by examining the length.
Full Code
module AOC2022.Day05 (spec) where
import Control.Applicative
import Data.Array
import Data.Char
import Data.List
import Data.Maybe
import Input
import Test.Hspec
import Text.ParserCombinators.Parsec
stacks :: Array Int String
stacks =
listArray
(1, 9)
[ "BVWTQNHD",
"BWD",
"CJWQST",
"PTZNRJF",
"TSMJVPG",
"NTFWB",
"NVHFQDLB",
"RFPH",
"HPNLBMSZ"
]
data Move = Move Int Int Int
parseMove :: GenParser Char u Move
parseMove =
liftA3
Move
(string "move " >> parseInt)
(string " from " >> parseInt)
(string " to " >> parseInt)
input :: IO (Either ParseError [Move])
input = traverse (parse parseMove "") . lines <$> readDay 2022 5
spec :: IO ()
spec = hspec $ do
describe "Part 1" $ do
it "parses the stacks" $ do
part1 [] `shouldBe` "BBCPTNNRH"
it "runs on custom input" $ do
myInput <- input
part1 <$> myInput `shouldBe` Right "_________" -- redacted
describe "Part 2" $ do
it "runs on custom input" $ do
myInput <- input
part2 <$> myInput `shouldBe` Right "_________" -- redacted
describe "Parsing" $ do
it "parses the raw stack string" $ do
parse parseStacks "" rawStacks
`shouldBe` Right
[ "BVWTQNHD",
"BWD",
"CJWQST",
"PTZNRJF",
"TSMJVPG",
"NTFWB",
"NVHFQDLB",
"RFPH",
"HPNLBMSZ"
]
move :: Array Int String -> Move -> Array Int String
move a (Move 0 _ _) = a
move a (Move n x y) =
let (h, rest) = splitAt 1 (a ! x)
in move (a // [(x, rest), (y, h ++ (a ! y))]) (Move (n - 1) x y)
peekStacks :: Array Int String -> String
peekStacks = fmap head . elems
part1 :: [Move] -> String
part1 = peekStacks . foldl move stacks
moveAll :: Array Int String -> Move -> Array Int String
moveAll a (Move n x y) =
let (pickedUp, rest) = splitAt n (a ! x)
in a // [(x, rest), (y, pickedUp ++ (a ! y))]
part2 :: [Move] -> String
part2 = peekStacks . foldl moveAll stacks
-- Parsing
rawStacks :: String
rawStacks =
unlines
[ "[B] [N] [H]",
"[V] [P] [T] [V] [P]",
"[W] [C] [T] [S] [H] [N]",
"[T] [J] [Z] [M] [N] [F] [L]",
"[Q] [W] [N] [J] [T] [Q] [R] [B]",
"[N] [B] [Q] [R] [V] [F] [D] [F] [M]",
"[H] [W] [S] [J] [P] [W] [L] [P] [S]",
"[D] [D] [T] [F] [G] [B] [B] [H] [Z]",
" 1 2 3 4 5 6 7 8 9 "
]
parseStacks :: GenParser Char u [String]
parseStacks = fmap catMaybes . transpose <$> parseLines
where
parseCrate = find isLetter . Just <$> (oneOf "[ " *> anyChar <* oneOf " ]")
parseLine = parseCrate `sepBy1` char ' '
parseLines = parseLine `endBy1` newlineAdvent of Code 2022 Series
This post is part of a series describing my Haskell solutions to Advent of Code 2022.
Next: Day 6: Tuning Trouble Previous: Day 4: Camp Cleanup
Cheers!