This is another example, like day 6, of a puzzle where a direct approach is sufficient for part 1 but another data structure is needed for the much larger instance in part 2.
Parsing the input simple enough, converting the set of rules in a
Map from the pair to the element inserted.
inputP = (,) <$> (many1 letter) <* many1 endOfLine <*> rulesP rulesP = M.fromList <$> ruleP `sepBy` endOfLine ruleP = (,) <$> many1 letter <* " -> " <*> many1 letter
This requires the
merge functions, to split a polymer into the overlapping pairs, then merge a polymer with the new elements.
mkPairs :: String -> [String] mkPairs polymer = map stringify $ zip polymer $ tail polymer stringify (a, b) = [a, b] merge :: [a] -> [a] -> [a] merge  ys = ys merge (x:xs) ys = x : (merge ys xs)
After that the naive approach applies the rules and creates a new polymer, and simulation of the whole is by
step. The final polymer is transformed into a MultiSet to count how many of each element is in the final polymer.
part1 :: RuleSet -> String -> Int part1 rules template = (last counts) - (head counts) where result = (simulateNaive rules template) !! 10 counts = sort $ map snd $ MS.toOccurList $ MS.fromList result simulateNaive :: RuleSet -> String -> [String] simulateNaive rules polymer = iterate (stepNaive rules) polymer stepNaive :: RuleSet -> String -> String stepNaive rules polymer = merge polymer $ concatMap (rules !) $ mkPairs polymer
The exponential growth of the polymer means I can't keep the polymer as a list of elements. Instead, I treat it as a MultiSet of the pairs present in the polymer. At each step in the synthesis, I create a new MultSet of the counts.
(I'll admit, I was very tired when attempting this puzzle and stole the idea of counting pairs from many suggestions on the solutions thread.)
For example, and following the example in the problem specification, the pair
NN will convert into
NCN. That will be stored as the two pairs
CN, ready for the next step.
That leads to a direct solution, where each pair in the initial polymer converts into two pairs in the result.
step :: RuleSet -> PolyPairs -> PolyPairs step rules polymer = MS.union firsts seconds where firsts = MS.map (addFirst rules) polymer seconds = MS.map (addSecond rules) polymer addFirst :: RuleSet -> String -> String addFirst rules pair = a : c where a = pair!!0 c = rules ! pair addSecond :: RuleSet -> String -> String addSecond rules pair = c ++ [a] where a = pair!!1 c = rules ! pair
Solving the problem is again an
iterate to generate all the stages.
The next problem is to extract the counts of single elements from the set of pairs. Every element is a member of two overlapping pairs, so if I count how often an element occurs as the first element of a pair and the second element, that will give me double the number of elements. The exception is the first and last pairs in the polymer, which only occur once.
countElements :: PolyPairs -> M.Map Char Int countElements pairs = counts where firsts = MS.map (!!0) pairs seconds = MS.map (!!1) pairs elems = S.union (MS.toSet firsts) (MS.toSet seconds) counts = M.map ((`div` 2) . (+ 1)) $ MS.toMap $ MS.union firsts seconds
Thoughts on MultiSet
The multiset library does much the same as the
Counter object in Python, and the functions provided in the library do mostly what I wanted. There were two limitations, though.
One was that type is only polymorphic in the elements, but not the count. If I want to store more items than could fit in an
Int, I can't use this implementation of MultiSet.
The other limitation is the lack of a
mapWithOccurrence function, to apply a function to a multiset that is aware of the number of occurrences of each item.