Advent of Code 2024: Day 20

For day 20, we return to a maze problem. The maze involved, however, is trivial — there are no decision points, it is just a convoluted path.

;;; -*- Lisp -*-

(in-package "ADVENT2024/DAY20")

(defun read-input (input-pathname)
  (read-file-into-grid
    (char-interner #’identity (find-package "ADVENT2024/DAY20"))
     input-pathname))

(defun find-start-and-goal (maze)
  (let ((inverse (invert-grid maze ’|.|)))
    (values (car (gethash ’S inverse))
            (car (gethash ’E inverse)))))

We compute the distance to the goal at all points along the path by walking the path backwards.

(defun compute-distances (maze)
  (let ((distances (make-grid (grid-height maze) (grid-width maze)
                              :initial-element nil)))
    (multiple-value-bind (start goal) (find-start-and-goal maze)
      (declare (ignore start))
      (let iter ((current goal)
                 (distance 0))
        (when current
          (setf (grid-ref distances current) distance)
          (iter (let* ((neighbors (#M2v+ (scan ’list (list +north+ +south+ +east+ +west+))
                                     (series current)))
                       (fill? (#M(lambda (maze neighbor)
                                   (and (on-grid? maze neighbor)
                                        (not (eql (grid-ref maze neighbor) ’\#))
                                        (null (grid-ref distances neighbor))))
                                 (series maze)
                                 neighbors)))
                  (collect-first (choose fill? neighbors)))
                (1+ distance))))
      distances)))

When we run through the maze we are allowed to cheat just once by walking through a wall. For part 1, we can walk just one step through a wall, but for part 2, we can walk up to 20 steps ignoring the walls. We might as well combine the two solutions into a single parameterized function. We will be asked to count the number of cheats that shorten the path by at least 100 steps.

I tried for quite some time to come up with a series oriented way to solve this, but it turned out to be much easier to just write a named-let iterative loop. So much for series.

First, we have a function that finds the cheats for a specific location. We are given a grid of distances to the goal, a coord that we start from, the current distance to the goal, the number of steps we can take through the walls, and the number of steps we have to shave off to count this cheat.

We iterate in a square grid centered at the current location and twice as wide plus one as the cheat steps. Check the locations in the distance grid that fall within the square and this tells us how much closer to the goal we can get by cheating to that location. We have to add in the manhattan distance from the current location to the cheat location to get the total distance. Subtract that from the original distance to the goal and we have the number of steps we save by using this cheat. If it exceeds our threshold, we count it.

(defun scan-square-coords (size)
  (declare (optimizable-series-function))
  (let ((displacement (coord size size)))
    (#M2v- (scan-coords (1+ (* size 2)) (1+ (* size 2)))
           (series displacement))))

(defun count-location-cheats (distances coord distance cheat-steps threshold)
  (collect-sum
   (choose
    (mapping (((cheat-vec) (scan-square-coords cheat-steps)))
      (let ((manhattan-distance (+ (abs (column cheat-vec)) (abs (row cheat-vec))))
            (cheat-coord (2v+ coord cheat-vec)))
        (and (<= manhattan-distance cheat-steps)
             (on-grid? distances cheat-coord)
             (let ((cheat-distance (grid-ref distances cheat-coord)))
               (and cheat-distance
                    (let* ((distance-if-cheating (+ manhattan-distance cheat-distance))
                           (savings (- distance distance-if-cheating)))
                      (and (>= savings threshold)
                           1))))))))))

So then we just iterate over the locations in the distance grid and call this function for each location, summing the results.

(defun count-cheats (distances-grid cheat-steps threshold)
  (collect-sum
   (choose
    (mapping (((coord distance) (scan-grid distances-grid)))
      (and distance
           (count-location-cheats distances-grid coord distance cheat-steps threshold))))))

For part 1, we can only take two steps through a wall.

(defun part-1 ()
  (count-cheats (compute-distances (read-input (input-pathname))) 2 100))

For part 2, we can take up to 20 steps through a wall.

(defun part-2 ()
  (count-cheats (compute-distances (read-input (input-pathname))) 20 100))

Advent of Code 2024: Day 19

For day 19, we are constructing sequences from fragments. We are first given a list of fragments, separated by commas. For example:

r, wr, b, g, bwu, rb, gb, br

The we are given a series of sequences that we need to construct by concatenating the fragments. For example:

brwrr  = br + wr + r
bggr   = b + g + g + r

;;; -*- Lisp -*-

(in-package "ADVENT2024/DAY19")

(defun read-input (input-pathname)
  (let ((parsed
          (collect 'list
            (#M(lambda (line)
                 (map 'list #'str:trim (str:split #\, line)))
               (scan-file input-pathname #'read-line)))))
    (values (first parsed) (map 'list #'first (rest (rest parsed))))))

Our job is to determine if the sequences can be constructed from the fragments. This is an easy recursive predicate:

(defun can-make-sequence? (fragments sequence)
  (or (zerop (length sequence))
      (some
       (lambda (fragment)
         (multiple-value-bind (prefix? suffix)
             (starts-with-subseq fragment sequence :return-suffix t)
           (and prefix?
                (can-make-sequence? fragments suffix))))
      fragments)))

Part 1 is to determine how many of the sequences can be constructed from the fragments.

(defun part-1 ()
  (multiple-value-bind (fragments sequences) (read-input (input-pathname))
    (count-if (lambda (sequence)
                  (can-make-sequence? fragments sequence))
              sequences)))

Part 2 is to count the number of ways we can construct the sequences from the fragments. Naively, we would just count the number of ways we can construct each sequence using each of the fragments as the first fragment and then sum them.

(defun count-solutions (fragments sequence)
  (if (zerop (length sequence))
      1
      (collect-sum
        (#M(lambda (fragment)
             (multiple-value-bind (prefix? suffix)
                 (starts-with-subseq fragment sequence :return-suffix t)
               (if prefix?
                   (count-solutions fragments suffix)
                   0)))
          (scan 'lists fragments)))))

But the naive approach won’t work for the larger input. The combinatorics grow far too quickly, so we need to be more clever. One possible way to do this is with “dynamic programming”, but most of the times I've seen this used, it involved a table of values and you had to invert your solution to fill in the table from the bottom up. But this is unnecessarily complicated. It turns out that “dynamic programming” is isomorphic to simple memoized recursive calls. So we won't bother with the table and inverting our solution. We'll just add some ad hoc memoization to our recursive count-solutions:

(defparameter *count-solutions-cache* (make-hash-table :test 'equal))

(defun count-solutions (fragments sequence)
  (let ((key (cons fragments sequence)))
    (or (gethash key *count-solutions-cache*)
        (setf (gethash key *count-solutions-cache*)
              (if (zerop (length sequence))
                  1
                  (collect-sum
                    (#M(lambda (fragment)
                         (multiple-value-bind (prefix? suffix)
                             (starts-with-subseq fragment sequence :return-suffix t)
                           (if prefix?
                               (count-solutions fragments suffix)
                               0)))
                      (scan 'list fragments))))))))

(defun part-2 ()
  (multiple-value-bind (fragments sequences) (read-input (input-pathname))
    (collect-sum
     (#M(lambda (sequence)
          (count-solutions fragments sequence))
        (scan ’list sequences)))))

This runs at quite a reasonable speed.

Advent of Code 2024: Day 18

For day 18, we have a maze again, but this time the input is given as coordinate pairs of where the walls go. The start and goal are the upper left and lower right respectively.

(in-package "ADVENT2024/DAY18")

(defun read-input (file grid n-bytes)
  (iterate ((coord (#M(lambda (line)
                       (apply #’coord (map ’list #’parse-integer (str:split #\, line))))
                      (cotruncate (scan-file file #’read-line)
                                  (scan-range :below n-bytes)))))
    (setf (grid-ref grid coord) ’\#))
  (setf (grid-ref grid (coord 0 0)) ’|S|)
  (setf (grid-ref grid (coord (1- (grid-height grid)) (1- (grid-width grid)))) ’|E|))

(defun sample-input ()
  (let ((grid (make-array (list 7 7) :initial-element ’|.|)))
    (read-input (sample-input-pathname) grid 12)
    grid))

(defun input (n-bytes)
  (let ((grid (make-grid 71 71 :initial-element ’|.|)))
    (read-input (input-pathname) grid n-bytes)
    grid))

The bulk of the solution simply reuses the Dijkstra’s algorithm from day 16. I won’t reproduce the code here. We just adjust the path scorer to not penalize for turns.

For part 1, we load the first 1024 walls and find a shortest path.

(defun part-1 ()
  (let* ((grid (input 1024))
         (solutions (solve-maze grid)))
    (score-path (car solutions))))

For part 2, we want to find the first wall in the list of walls that prevents us from reaching the goal. Binary search time.

(defun total-walls ()
  (collect-length (scan-file (input-pathname) #’read-line)))

(defun binary-search (pass fail)
  (if (= (1+ pass) fail)
      (list pass fail)
      (let* ((mid (floor (+ pass fail) 2))
             (grid (input mid)))
        (let ((solutions (solve-maze grid)))
          (if (null solutions)
              (binary-search pass mid)
              (binary-search mid fail))))))

(defun get-coord (n)
  (collect-nth n (scan-file (input-pathname) #’read-line)))

(defun part-2 ()
  (collect-nth (car (binary-search 1024 (total-walls)))
  (scan-file (input-pathname) #’read-line)))