Wednesday, February 26, 2025

Advent of Code 2024: Day 15

For day 15, we are simulating moving crates around a warehouse. We are give a map of the warehouse which we will read into a grid, and a list of moves of our little robot. When the robot encounters a crate, it will push it in the direction it is moving, if it can. If the crate rests against another crate, it will push both crates. If the crate rests against a wall, it will not move. If the crate cannot move, the robot doesn’t move either. The robot can only push.

The second part of the puzzle uses double-wide crates, so our input code has a flag to indicate whether to create single-wide or double-wide crates in the initial grid.

;;; -*- Lisp -*-

(in-package "ADVENT2024/DAY15")

(defun decode-cell (string package wide?)
  (if wide?
      (cond ((equal string "#") (list ’\# ’\#))
            ((equal string "O") (list ’[ ’]))
            ((equal string ".") (list ’\. ’\.))
            ((equal string "@") (list ’@ ’\.))
            (t (error "Unknown cell ~a" string)))
      (list (intern (string-upcase string) package))))

In the input, the directions are represented with the characters ^, v, <, and >. We will convert these to the corresponding vectors.

(defun decode-move (move)
  (cond ((equal move "<") +west+)
        ((equal move "^") +north+)
        ((equal move ">") +east+)
        ((equal move "v") +south+)
        (t (error "Unknown move ~a" move))))

We’ll use a regular expression to parse the input. If it is a line consisting of #, O, ., or @, we’ll decode it as a row of the grid. If it is a line consisting of one of the directions, we’ll decode it as a move.

(defun read-input (input-pathname &optional (wide? nil))
  (multiple-value-bind (blanks grids moves)
      (#3M(lambda (line)
            (cl-ppcre:register-groups-bind (blank grid move)
                ("(^$)|([#.O@]+)|([><v^]+)" line)
              (values blank grid move)))
          (scan-file input-pathname #’read-line))
    (let ((blank-lines (collect ’list (choose blanks)))
          (grid-lines  (collect ’list
                         (#M(lambda (line)
                              (collect-append (#Mdecode-cell
                                               (#Mstring (scan ’string line))
                                               (series (find-package "ADVENT2024/DAY15"))
                                               (series wide?))))
                            (choose grids))))
          (move-list (collect-append (#M(lambda (line)
                                          (collect ’list (#Mdecode-move
                                                           (#Mstring (scan ’string line)))))
                                        (choose moves)))))
      (declare (ignore blank-lines))
      (values (make-grid (length grid-lines) (length (first grid-lines)) :initial-contents grid-lines)
              move-list))))

can-move-to? will determine if we can move to a particular cell in the grid from a particular direction. If the cell is empty, we can move there. If the cell is a crate, we can move there if we can move the crate.

(defun can-move-to? (grid coord delta)
  "True if location on grid at coord is empty, or item at location can move in direction."
  (and (on-grid? grid coord)
       (or (eql (grid-ref grid coord) ’\.)
           (can-move? grid coord delta))))

can-move? will determine if we can move an item on the grid one step in a particular direction. The tricky part is double wide crates. We need to check both cells to see if we can move the entire crate.

(defun can-move? (grid coord delta)
  "True if item on grid at coord can move in direction."
  (and (on-grid? grid coord)
       (ecase (grid-ref grid coord)
         (\. (error "No item at coord."))
         (\# nil)
         (@ (let ((target (2v+ coord delta)))
               (can-move-to? grid target delta)))
         (O (let ((target (2v+ coord delta)))
               (can-move-to? grid target delta)))
         (\[ (if (or (equal delta +north+)
                      (equal delta +south+))
                  (let ((target1 (2v+ coord delta))
                        (target2 (2v+ (2v+ coord delta) +east+)))
                    (and (can-move-to? grid target1 delta)
                         (can-move-to? grid target2 delta)))
                  (let ((target (2v+ coord delta)))
                    (can-move-to? grid target delta))))
         (\] (if (or (equal delta +north+)
                      (equal delta +south+))
                  (let ((target1 (2v+ coord delta))
                        (target2 (2v+ (2v+ coord delta) +west+)))
                    (and (can-move-to? grid target1 delta)
                         (can-move-to? grid target2 delta)))
                  (let ((target (2v+ coord delta)))
                    (can-move-to? grid target delta)))))))

move! will move an item on the grid one step in a particular direction if possible. It returns the new grid location if it moved, or nil if it didn’t. When moving an item we put a blank spot where the item was. The tricky part is double-wide crates, where we need to move both cells.

(defun move! (grid coord delta)
  "Move item on grid at coord in direction delta."
  (if (can-move? grid coord delta)
      (ecase (grid-ref grid coord)
        (\. (error "Cannot move empty locations."))
        (\# (error "Cannot move walls."))
        (@ (let ((target (2v+ coord delta)))
               (unless (eql (grid-ref grid target) ’\.)
                 (move! grid target delta))
               (setf (grid-ref grid target) ’@
                     (grid-ref grid coord) ’\.)
               target))

        (O (let ((target (2v+ coord delta)))
               (unless (eql (grid-ref grid target) ’\.)
                 (move! grid target delta))
               (setf (grid-ref grid target) ’O
                     (grid-ref grid coord) ’\.)
               target))

        (\[ (let* ((targetl (2v+ coord delta))
                    (targetr (2v+ targetl +east+)))
               (unless (or (eql delta +east+)
                           (eql (grid-ref grid targetl) ’|.|))
                 (move! grid targetl delta))
               (unless (or (eql delta +west+)
                           (eql (grid-ref grid targetr) ’\.))
                 (move! grid targetr delta))
               (setf (grid-ref grid targetl) ’[
                     (grid-ref grid targetr) ’])
               (unless (eql delta +east+)
                 (setf (grid-ref grid (2v+ coord +east+)) ’\.))
               (unless (eql delta +west+)
                 (setf (grid-ref grid coord) ’\.))
               targetl))

        (\] (let* ((targetr (2v+ coord delta))
                    (targetl (2v+ targetr +west+)))
               (unless (or (eql delta +east+)
                           (eql (grid-ref grid targetl) ’\.))
                 (move! grid targetl delta))
               (unless (or (eql delta +west+)
                           (eql (grid-ref grid targetr) ’\.))
                 (move! grid targetr delta))
               (setf (grid-ref grid targetl) ’[
                     (grid-ref grid targetr) ’])
               (unless (eql delta +east+)
                 (setf (grid-ref grid coord) ’\.))
               (unless (eql delta +west+)
                 (setf (grid-ref grid (2v+ coord +west+)) ’\.))
           targetr))))
    coord))

We need a function to find the initial location of the robot:

(defun find-robot (grid)
  (collect-first
   (choose
    (mapping (((coord item) (scan-grid grid)))
      (when (eql item ’@)
        coord)))))

And we need a function to score the grid.

(defun score-map (grid)
  (collect-sum
   (mapping (((coord item) (scan-grid grid)))
     (if (or (eql item ’O)
             (eql item ’[))
         (+ (* (row coord) 100) (column coord))
         0))))

It isn’t necessary for the solution, but it is helpful when debugging to have a function to print the grid.

(defun show-grid (grid)
  (dotimes (row (grid-height grid))
    (dotimes (column (grid-width grid))
      (format t "~a" (grid-ref grid (coord column row))))
    (format t "~%")))

To solve the puzzle, we use fold-left to drive the robot using the list of moves. This will side-effect the grid. When we are done moving, we score the grid.

(defun puzzle (input-file wide?)
  (multiple-value-bind (grid moves) (read-input input-file wide?)
    (fold-left (lambda (robot move)
                 (move! grid robot move))
               (find-robot grid)
               moves)
    (score-map grid)))

(defun part-1 ()
  (puzzle (input-pathname) nil))

(defun part-2 ()
  (puzzle (input-pathname) t))

No comments: