Advent of Code 2022 day 5

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


    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 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).

    [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


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

    Neil Smith

    Read more posts by this author.