Solve day 14

Author: Demindiro

2021/14/input.txt

@@ -0,0 +1,102 @@
+CKFFSCFSCBCKBPBCSPKP
+
+NS -> P
+KV -> B
+FV -> S
+BB -> V
+CF -> O
+CK -> N
+BC -> B
+PV -> N
+KO -> C
+CO -> O
+HP -> P
+HO -> P
+OV -> O
+VO -> C
+SP -> P
+BV -> H
+CB -> F
+SF -> H
+ON -> O
+KK -> V
+HC -> N
+FH -> P
+OO -> P
+VC -> F
+VP -> N
+FO -> F
+CP -> C
+SV -> S
+PF -> O
+OF -> H
+BN -> V
+SC -> V
+SB -> O
+NC -> P
+CN -> K
+BP -> O
+PC -> H
+PS -> C
+NB -> K
+VB -> P
+HS -> V
+BO -> K
+NV -> B
+PK -> K
+SN -> H
+OB -> C
+BK -> S
+KH -> P
+BS -> S
+HV -> O
+FN -> F
+FS -> N
+FP -> F
+PO -> B
+NP -> O
+FF -> H
+PN -> K
+HF -> H
+VK -> K
+NF -> K
+PP -> H
+PH -> B
+SK -> P
+HN -> B
+VS -> V
+VN -> N
+KB -> O
+KC -> O
+KP -> C
+OS -> O
+SO -> O
+VH -> C
+OK -> B
+HH -> B
+OC -> P
+CV -> N
+SH -> O
+HK -> N
+NO -> F
+VF -> S
+NN -> O
+FK -> V
+HB -> O
+SS -> O
+FB -> B
+KS -> O
+CC -> S
+KF -> V
+VV -> S
+OP -> H
+KN -> F
+CS -> H
+CH -> P
+BF -> F
+NH -> O
+NK -> C
+OH -> C
+BH -> O
+FC -> V
+PB -> B

2021/14/main.hs

@@ -0,0 +1,40 @@
+import qualified Data.Map.Strict as Map
+import Data.List (sort, group)
+import Control.Arrow ((&&&))
+
+type Template = Map.Map String Char
+type FreqMap  = Map.Map String Int
+type CountMap = Map.Map Char   Int
+
+parseInput :: String -> (String, Template)
+parseInput l = (start, Map.fromList $ map f patterns)
+  where (start:_:patterns) = lines l
+        f p = let [l, _, r] = words p in (l, head r)
+
+freqMap :: String -> Template -> FreqMap
+freqMap [_] m = Map.empty
+freqMap (l:s@(r:_)) m = add [l, r] 1 $ freqMap s m
+
+step :: [(String, Int)] -> Template -> FreqMap -> CountMap -> (FreqMap, CountMap)
+step [] templ freq count = (freq, count)
+step ((p@[l,r],i):ss) templ freq count = step ss templ freq' count'
+  where x   = templ Map.! p
+        p'l = [l, x]
+        p'r = [x, r]
+        freq'   = add p'r i $ add p'l i $ sub p i freq
+        count'  = add x i count
+
+get k = maybe 0 id . Map.lookup k
+add k n m = Map.insert k (get k m + n) m
+sub k n m = Map.insert k (get k m - n) m
+
+main = parseInput <$> readFile "input.txt"
+   >>= \i -> mapM_ print [f 10 i, f 40 i]
+  where
+    f n (s, templ) = diff $ snd $ foldl (const . g) (freq, count) [1..n]
+      where
+        freq = freqMap s templ
+        count = Map.fromList $ map (head &&& length) $ group $ sort s
+        g (s, x) = step (Map.toList s) templ s x
+        diff m = maximum l - minimum l
+          where l = Map.elems m

2021/14/test.txt

@@ -0,0 +1,18 @@
+NNCB
+
+CH -> B
+HH -> N
+CB -> H
+NH -> C
+HB -> C
+HC -> B
+HN -> C
+NN -> C
+BH -> H
+NC -> B
+NB -> B
+BN -> B
+BB -> N
+BC -> B
+CC -> N
+CN -> C