day14: Complete first puzzle

14/Parsing.hs

@@ -0,0 +1,32 @@
+module Parsing (
+  splitByString,
+  parseCoordinates
+  ) where
+
+import           Data.List (isPrefixOf)
+
+splitByString :: String -> String -> [String]
+splitByString _ "" = []
+splitByString splitter string =
+  let (chunk, rest) = spanNextSplit string
+  in
+    chunk:(splitByString splitter rest)
+    where
+      spanNextSplit :: String -> (String, String)
+      spanNextSplit [] = ([], [])
+      spanNextSplit everything@(char:rest)
+        | splitter `isPrefixOf` rest =
+          ([char], (drop ((length splitter) + 1) everything))
+        | otherwise =
+          let
+            (start, end) = spanNextSplit rest
+          in
+            (char:start, end)
+
+parseCoordinates :: String -> [(Int, Int)]
+parseCoordinates =
+  map (tuplify . map read . splitByString ",") . lines
+  where
+    tuplify :: [a] -> (a, a)
+    tuplify [a, b] = (a, b)
+    tuplify _      = error "Can't parse coordinates from non-2-sized lists"

14/Reducers.hs

@@ -0,0 +1,28 @@
+module Reducers (
+  leastMostOcc,
+  leastMost,
+  most,
+  least
+  ) where
+
+import           Data.List (group, sortBy, sort)
+import           Data.Ord  (comparing)
+
+groupOccurrences :: (Ord a) => [a] -> [[a]]
+groupOccurrences = sortBy (comparing length) . group . sort
+
+leastMostOcc :: (Ord a) => [a] -> (Int, Int)
+leastMostOcc list = ((length . last) occ, (length . head) occ)
+  where
+    occ = groupOccurrences list
+
+leastMost :: (Ord a) => [a] -> (a, a)
+leastMost list = ((head . last) occ, (head . head) occ)
+  where
+    occ = groupOccurrences list
+
+least :: (Ord a) => [a] -> a
+least = fst . leastMost
+
+most :: (Ord a) => [a] -> a
+most = snd . leastMost

14/input.txt

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

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