Advent of Code 2022 day 5

Day 5 was an adventure in parsing! Luckily, my old faithful attoparsec was up to the job.

Representation

The first thing was to sort out the representation. The Move was a new agebraic data type, essentially a triple of <quantity, from, to>. A Crate held its name. Each stack of crates was held as a list, with the topmost crate being the head of the list. The Wharf was an IntMap [Crate] from integer position to the stack of crates at that position.

data Crate = Crate Char deriving (Show, Eq)
type Wharf = M.IntMap [Crate]

data Move = Move Int Int Int -- quantity, from, to
  deriving (Show, Eq)
  
extractName :: Crate -> Char
extractName (Crate c) = c   

Parsing

Parsing the input was the hardest part of the puzzle, but it was mainly a case of follow the structure.

The input file comprised two parts: a picture of the wharf (the stacks of crates) and a list of moves. The picture of the wharf itself comprised two parts: a picture of the crates and a list of stack names see the example below).

    [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 2

The picture of the crates was the hard bit. I had to parse it in the order it appears in the file: row by row. But I wanted to end up with the crates column-by-column to I could store each stack in the Wharf. Luckily, switching between rows and columns is handled by transpose. But how to read the rows? And how to keep track of the blank spaces between the tallest few stacks?

If we imagine the picture is a grid of positions, each place in the grid is either occupied by a Crate or is empty. In other words, each row is a list of Maybe Crate.

That gave me the parser.

Working from the bottom up, a Crate is a letter between square brackets. A blank is three spaces. Each cell in the picture is either a crate or blank. Each line of the picture is a bunch of cells separated by spaces (and at least one cell).

blankP = Nothing <$ (count 3 space)
crateP = (Just . Crate) <$> ("[" *> letter) <* "]"

wharfCellP = crateP <|> blankP

wharfLineP = wharfCellP `sepBy1` (char ' ')

Meanwhile, the stack label row is some whitespace, then some numbers separated by spaces, then some more whitespace. (Note that this consumes the newlines before and after this line.)

The wharf as a whole is a bunch of picture lines along with the label row.

stackLabelsP = (many1 space) 
            *> (decimal `sepBy` (many1 space)) 
            <* (many1 space)

wharfP = (,) <$> (wharfLineP `sepBy` endOfLine) <*> stackLabelsP            

Parsing the moves is easy in comparison. The moves are separated by newlines, and each move is some text delimiting the three numbers we want. Finally, the problem description is the wharf followed by the moves.

movesP = moveP `sepBy` endOfLine
moveP = Move <$> ("move " *> decimal) 
             <*> (" from " *> decimal) 
             <*> (" to " *> decimal)

problemP = (,) <$> wharfP <*> movesP

Then, to convert the output of the parser into the Wharf. I do this in three stages:

1. convert rows to columns
2. combine all the Just values in each stack
3. combine the stacks with the labels to build the Wharf

makeWharf :: [[Maybe Crate]] -> [Int] -> Wharf
makeWharf wharfLines colNames = M.fromList $ zip colNames wharfCols
  where wharfCols = fmap catMaybes $ transpose wharfLines

Solving the tasks

There are two ways of moving crates around, so there are two sets of functions to perform them. In each case, applying a bunch of moves is a foldl , folding each move into a wharf to create a new wharf. (It has to be done from the left, to preserve the order of operations.)

Part 2 is easier to explain.

A single move, moving a substack of crates from place to place, is done by applyMove2. It finds the crates at the origin, finds the substack to move, finds the existing stack at the destination, then updates the origin and destination stacks. Applying the sequence of moves is the fold.

applyMoves2 :: Wharf -> [Move] -> Wharf
applyMoves2 wharf moves = foldl' applyMove2 wharf moves

applyMove2 :: Wharf -> Move -> Wharf
applyMove2 wharf (Move n from to) = M.insert from origin' 
                                  $ M.insert to destination wharf
  where origin = wharf!from
        moving = take n origin
        origin' = drop n origin
        destination = moving ++ (fromMaybe [] $ wharf!?to)

The moves in part 1 is the same pattern, but applying a single move instruction is itself the repeated application of a move 1 from here to there, so that requires an additional level of fold. I use replicate to generate the list of single-move steps from the one move instruction.

applyMoves1 :: Wharf -> [Move] -> Wharf
applyMoves1 wharf moves = foldl' applyMove1 wharf moves

applyMove1 :: Wharf -> Move -> Wharf
applyMove1 wharf m@(Move n _ _) = foldl' makeMove1 wharf (replicate n m)

makeMove1 :: Wharf -> Move -> Wharf
makeMove1 wharf (Move _ from to) = M.insert from origin 
                                 $ M.insert to destination wharf
  where (c:origin) = wharf!from
        destination = c:(fromMaybe [] $ wharf!?to)

All that's left is a convenience function to extract the names of the top crates on the wharf.

part1 :: Wharf -> [Move] -> String
part1 wharf moves = showTops $ applyMoves1 wharf moves

part2 :: Wharf -> [Move] -> String
part2 wharf moves = showTops $ applyMoves2 wharf moves

showTops :: Wharf -> String
showTops wharf = fmap extractName $ fmap (head . snd) $ M.toAscList wharf

Code

You can get the code from my locally-hosted Git repo, or from Gitlab.