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.