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 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":
| a | A | u | N | Y | y | n | b | s | o |
| a | A | u | N | Y | y | n | b | s | o |
| u | N | n | b | s | o |
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".
| u | b | s | o |
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.
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
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.
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=))
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)
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.