I treated day 14's puzzle as an exercise in looking at a Haskell library that I knew had to exist, but hadn't found before: the MultiSet.
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
Part 1
This requires the mkPairs and 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 iterate-ing the 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
Part 2
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 NC and 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.
Code
You can get the code from my locally-hosed Git repo, or from Gitlab.