day14: Complete first puzzle

14/polymerization.hs

@@ -0,0 +1,64 @@
+import           Data.Map.Strict (Map, (!))
+import qualified Data.Map.Strict as Map
+import           Parsing         (splitByString)
+import           Reducers        (leastMostOcc)
+
+main :: IO ()
+main = do
+  input <- getContents
+  let
+    polymer = parsePolymer input
+  (putStrLn . show . solution1) polymer
+
+parsePolymer :: String -> ([Char], Map [Char] Char)
+parsePolymer input = (template input, rules input)
+  where
+    template :: String -> String
+    template = head . splitByString "\n\n"
+    rules :: String -> Map [Char] Char
+    rules = Map.fromList . map tupelize . map (splitByString " -> ") . lines . last . splitByString "\n\n"
+    tupelize :: [String] -> ([Char], Char)
+    tupelize untupled = (head untupled, (head . last) untupled)
+
+solution1 :: ([Char], Map [Char] Char) -> Int
+solution1 (template, rules) = uncurry (-) (leastMostOcc polymer)
+  where
+    polymer :: [Char]
+    polymer = iterate (polymerize rules) template !! 10
+
+solution2 :: ([Char], Map [Char] Char) -> Int
+solution2 (template, rules) = undefined
+
+polymerize :: Map [Char] Char -> [Char] -> [Char]
+polymerize rules template = step template
+  where
+    step :: [Char] -> [Char]
+    step []      = []
+    step [final] = [final]
+    step (x:xs)  = x:(rules ! [x, head xs]):(step xs)
+
+-- Tests
+
+testInput1 = unlines [
+  "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"]
+
+testInputParsed1 = parsePolymer testInput1
+test1 = solution1 testInputParsed1 -- 1588
+test2 = solution2 testInputParsed1 -- 2188189693529