Advent Of Code Day 5 [spoilers]

I completely gave up on solving the Advent of Code problems as they went up, and I'm backfilling the days I missed, which is most of them.

Day 5 was the first time I really felt happy with my Haskell solution, because lists are a good way to solve this problem. We are given a long string of lower-case and upper-case letters, and asked to simulate a process where matched upper/lower pairs are removed. For example, "cBaAbc" becomes "cBbc" becomes "cc", but "bb" doesn't react further.

(Actually, all we're asked for is the length of the string after all the pairs have been removed, so it's not impossible that there might be a way to answer this without simulation.)

The key insight here is that any "cascade" of reactions takes place just before the place where a pair was removed, so we don't need to start over the search each time. (We also need to assume, or prove, that the order of elimination doesn't matter.) We can backtrack one position from our current position in the string, every time we eliminate a pair.

It doesn't seem very Haskell-ish to keep a position into a list, which would be horribly inefficient anyway. We can handle this by having a recursive function that keeps two lists, the unprocessed part of the string and the already-visited part of the string. The trick is to keep the latter in reverse order so that we can easily back up.

eliminatePolymers :: String -> String -> String
eliminatePolymers stack (x:[]) = reverse (x:stack)
eliminatePolymers [] (x:y:xs) =
   if match x y
   then eliminatePolymers [] xs
   else eliminatePolymers (x:[]) (y:xs)
eliminatePolymers (a:b) (x:y:xs) =
   if match x y
   then eliminatePolymers b (a:xs)
   else eliminatePolymers (x:(a:b)) (y:xs)

This version worked by it seemed a little redundant (in fact I did copy-and-paste.) Going down the direction of a second conditional didn't seem right; I managed to shorten it a little bit using guards:

eliminatePolymers :: String -> String -> String
eliminatePolymers stack (x:[]) = reverse (x:stack)
eliminatePolymers [] (x:y:xs)
  | match x y = eliminatePolymers [] xs
eliminatePolymers (p:ps) (x:y:xs)
  | match x y = eliminatePolymers ps (p:xs)
eliminatePolymers ps (x:y:xs) = eliminatePolymers (x:ps) (y:xs)

The match function is trivial:

match :: Char -> Char -> Bool
match x y =
  ( isUpper x && isLower y && (toLower x) == y ) ||
  ( isLower x && isUpper y && (toUpper x) == y )

And then the solution to part 1 is just (length (eliminatePolymers [] input).

Part 2 asks us to examine removing each of the 26 letter pairs and seeing which results in the shortest string after going through the process above. filter can remove the upper and lower pairs:

removeUnits x polymer = filter (\y -> toLower y /= x) polymer

And instead of calculating the minimum explicitly I generated a report of all the lengths (which was useful for testing with the short example given.)

lengthAfterRemoval a polymer = length (eliminatePolymers [] (removeUnits a polymer))

reportExperiment a =
  "Length after removing " ++ [a] ++ " = " ++ (show (lengthAfterRemoval a input))
  
letters = "abcdefghijklmnopqrstuvwxyz"

report = intercalate "\n" [ reportExperiment a | a <- letters ]

Full solution: https://github.com/mgritter/aoc2018/blob/master/day5/day5.hs