[nolan@nprescott.com] $  cat weblog archive feed

Advent of Code, Day Five

2019-10-26

Just another belated solution for last year's Advent of Code, this time, day five, Alchemical Reduction. I'm still plodding along in Common Lisp.

The Puzzle

The challenge is to "react" a string of ASCII characters where a reaction removes two adjacent matching characters, where a "match" is the same letter in opposite case ("A" and "a", "c" and "C" for example). Consider the input "aAuNYynbso":

aAuNYynbso
aAuNYynbso
uNnbso

In the above case, there are three "react-able" instances, first the leading pair of "A" and "a", then "Y" and "y", and finally the now-adjacent pair of "N" and "n".

ubso

I thought for a while on a recursive solution that might repeatedly check an input string where each input is the result of the previous reaction, but couldn't work out a fast way of checking for completion.

A Solution

The first step was to identify a match (letters of opposite case), the easiest way that I came up with that didn't rely on changing the case and comparing was to perform a logical XOR on the character codes, since any two ASCII letters of different case will result in a difference of 32. I've called it destroy? because the puzzle frames a "reaction" as destroying the adjacent "polymers":

(defun destroy? (a b)
  (and a b (= 32 (logxor (char-code a)
                         (char-code b)))))

One slightly tricky piece lay in the initial check for and a b, which is necessary due to how I later iterate the input string, I have to first verify that I haven't run off the end of the string in the loop that takes two inputs, which results in comparing one letter and NIL.

Much like previous puzzles I used a simple read-file function to collect all of the input (something like 50,000 characters) into a single string:

(defun read-lines (filename)
  "read lines as some lisp-y thing"
  (with-open-file (stream filename)
    (loop for line = (read-line stream nil)
      while line
      collect line)))

Another part which caught me out at first was to realize there is a trailing newline in the input, so I have to take only the first of the read lines.

(defparameter big-string
  (first (read-lines "day-5.txt")))

With that out of the way, all that remains is to implement a means of comparing each pair of adjacent characters in the string repeatedly. The easiest way I came up with was to treat "reacted" characters as a stack conditionally popping the stack of both characters in the case that they match:

(defun collapse (polymer-string)
  (let ((stack (list (elt polymer-string 0))))
    (loop for c across (subseq polymer-string 1)
          do (push c stack)
             (if (destroy? (first stack) (second stack))
                 (progn
                   (pop stack)
                   (pop stack))))
    stack))

The part that annoyed me a little was the setup necessary to prime the stack by pushing the first character of the string and then looping over the remainder. That being said, it is very fast to compute.

(time (length (collapse big-string)))

Evaluation took:
  0.005 seconds of real time
  0.004503 seconds of total run time (0.002015 user, 0.002488 system)
  100.00% CPU
  13,231,042 processor cycles

Part Two

The second piece of the puzzle requires finding the length of the minimum string of characters (polymers) resulting from removing all instances of a single character in either case.

The prerequisite pieces here are identifying all unique possible characters, in order to filter them out one by one, and then tracking the minimum for each iteration of the input-less-one character.

Helper Functions

As I've done previously, getting the set out of a list is most easily done using a hash table, here the keys are unique uppercase characters and the value is just t, I'm looping again to return just a list of the hash-keys. I'm converting to uppercase in order to reduce the number of minimization steps to be taken later, since all instances of a character are to be removed regardless of case.

(defun get-uniques (a-string)
  (let ((uniques (make-hash-table)))
    (loop for c across a-string
          do (setf (gethash (char-upcase c) uniques) t))
    (loop for key being the hash-key of uniques
          collect key)))

(defun remove-instance (character string)
  (remove character string :test #'char=))

The Result

Finally, to get the minimum, it turns out that the loop macro has some facilities to do just that, I supply the tallying function ((length (collapse ...))) and it automatically captures the current minimum across loops of the hash-keys list.

(defun minimize (polymer-string)
  (let ((unique-polymers (get-uniques polymer-string)))
    (loop for polymer in unique-polymers
          minimize (length (collapse (remove-instance polymer polymer-string))))))

(minimize big-string)

Thoughts

Looking at the solution, I have a similar feeling to the time I implemented the Monty Hall problem, the result is pleasingly readable:

(loop for polymer in unique-polymers
     minimize (length (collapse (remove-instance polymer polymer-string))))

I've mentioned previously some level of disdain for my own repeated use of the loop macro. I think, given the intervening time, I have to come to terms with the fact that it is a robust solution to many problems and a good addition to the language — Common Lisp doesn't really dictate how you do anything, so if I have a problem with "loop", it really is my problem.

If you think of a nice functional solution to part one, shoot me an email, I'd be interested to see it.