Advent of Code 2022 - Day 5: Supply Stacks

2022-12-05 :: programming, puzzle, racket

1 2	#lang iracket/lang #:require racket (require "../advent.rkt")

Day 5 - Part 1

Supply Stacks We’re given the following 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 2

And, fortunately for us, the first part has lines padded with spaces to be of equal length - this makes parsing just a little bit easier :) Even so, the built-in parsers we have for AoC are insufficient, so we’ll just use a custom parser that reads the file into a string, splits it on "\n\n", and then maps the string-split function over both parts - the stack lines and the command lines:

(match-define (list stack-lines command-lines)
  (~> (file->string "./day05.txt")
      (string-split _ "\n\n")
      (map (λ (s) (string-split s "\n")) _)))

The trickiest part of part 1 is parsing the pictorial description of the stacks into a useful representation. Our approach will be as follows:

A stack is represented as a list of chars e.g. stack 2 from above will be '(#\D #\C #\M)
Each stack is an element in the stacks list
We’ll use a trick of populating the stacks list with a placeholder to allow using 1-based indexing later
We can compute the number of stacks from the length of the input string n = (len + 1) / 4

Rather than try and keep track of all the stacks as we process each line, I thought it would be simpler to simply iterate over all the stack lines for each stack, and pull the crate letter from the nth position. The number of input lines is very small, so I feel this is a reasonable approach for AoC.

Getting a single create from a line is: (string-ref line (add1 (* i 4)))

Here is the parse-stacks function:

(define (parse-stacks stack-lines)
  (define (parse-stack lines i)
    (define (get-crate line)
      (string-ref line (add1 (* i 4))))

    (~> (map get-crate lines)
        (filter char-alphabetic? _)))

  (let* ([ lines (take stack-lines (sub1 (length stack-lines))) ]
         [ n     (/ (+ (string-length (first lines)) 1) 4)          ])
    (let loop ([ i 0 ][ stacks '(()) ])
      (if (>= i n)
          (reverse stacks)
          (loop (add1 i) (cons (parse-stack lines i) stacks))))))

The parse-commands function is much simpler, we just map the numbers parser over the input lines:

1	(define parse-commands (curry map numbers))

Now we have everything in place to create the stacks and commands:

(define stacks (parse-stacks stack-lines))
(define commands (parse-commands command-lines))

stacks

’(() (#\N #\Z) (#\D #\C #\M) (#\P))

commands

’((1 2 1) (3 1 3) (2 2 1) (1 1 2))

Here’s our function to move crates from one stack to another. I used the same argument order as our input data structure so I can easily apply the function with the input later:

(define (move-crates stacks n from-i to-i)
  (let* ([ from   (list-ref stacks from-i)                         ]
         [ to     (list-ref stacks to-i)                           ]
         [ stacks (list-set stacks to-i (append (reverse (take from n)) to)) ]
         [ stacks (list-set stacks from-i (drop from n))           ])
    stacks))

;; e.g.
(move-crates stacks 2 2 3)

’(() (#\N #\Z) (#\M) (#\C #\D #\P))

Lastly, we write the solver for part 1. It loops over the commands and applies them to the stacks data structure one at a time. When we’re done, we grab the top element of each stack and concatenate them all into a string:

(define (part1)
  (let loop ([ stacks stacks ][ commands commands ])
    (if (null? commands)
        (list->string (map car (cdr stacks)))
        (loop (apply move-crates stacks (car commands)) (cdr commands)))))

(part1)

“CMZ”

Part 2

I didn’t do a very good job of anticipating the very small change between parts today! The only change for part 2 is to change from a first-off-first-on approach in part 1 to a last-off-first-on approach in part 2. Unfortunately, that piece of logic is embedded deep within my move-crates function, so for now, I’ll just redefine the move-crates function with this small change of removing the reverse invocation, and just call part1 again:

(define (move-crates stacks n from-i to-i)
  (let* ([ from   (list-ref stacks from-i)                         ]
         [ to     (list-ref stacks to-i)                           ]
         [ stacks (list-set stacks to-i (append (take from n) to)) ]
         [ stacks (list-set stacks from-i (drop from n))           ])
    stacks))

(part1)

“MCD”

Refactor

Now for the fun part of eliminating the redundancy above! Since the only change between parts is the strategy used when moving creates, we’ll create two strategy functions, one for each part. Let’s define the first-off-first-on (FOFO) function for part 1:

1	(define strategy-fofo reverse)

And the first-off-last-on (FOLO) function for part 2:

1	(define strategy-folo identity)

Now our single move-crates function is:

(define (move-crates strategy stacks n from-i to-i)
  (let* ([ from   (list-ref stacks from-i)                        ]
         [ to     (list-ref stacks to-i)                          ]
         [ stacks (list-set stacks to-i 
                            (append (strategy (take from n)) to)) ]
         [ stacks (list-set stacks from-i (drop from n))          ])
    stacks))

And we need to modify the solver to accept a strategy:

(define (solve strategy)
  (let loop ([ stacks stacks ][ commands commands ])
    (if (null? commands)
        (list->string (map car (cdr stacks)))
        (loop (apply move-crates strategy stacks (car commands)) (cdr commands)))))

(solve strategy-fofo)

“CMZ”

1	(solve strategy-folo)

“MCD”