From 5eb58ad076f2cd435b11b140820da224b60b73d5 Mon Sep 17 00:00:00 2001 From: Aria Date: Mon, 2 Jan 2023 21:58:56 +0000 Subject: initial commit --- 2021/day14/14.hs | 43 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 43 insertions(+) create mode 100644 2021/day14/14.hs (limited to '2021/day14/14.hs') diff --git a/2021/day14/14.hs b/2021/day14/14.hs new file mode 100644 index 0000000..3221655 --- /dev/null +++ b/2021/day14/14.hs @@ -0,0 +1,43 @@ +{-# LANGUAGE OverloadedStrings #-} +module Main where + +import Data.Map (Map) +import qualified Data.Map as M +import qualified Data.Text as T + +type Pair = (Char, Char) + +doSubstitutions :: Map Pair Char -> Map Pair Int -> Map Pair Int +doSubstitutions rules s = M.fromListWith (+) $ concatMap checkPair (M.toList s) + where checkPair ((a, b), count) = case M.lookup (a, b) rules of + Just v -> [((a, v), count), ((v, b), count)] + Nothing -> [((a, b), count)] + +stringToPairs :: String -> Map Pair Int +stringToPairs s = M.fromListWith (+) $ [((a, b), 1) | (a, b) <- (zip s (tail s))] ++ [((last s, '_'), 1)] + +countLetters :: Map Pair Int -> Map Char Int +countLetters m = M.fromListWith (+) [(a, count) | ((a, _), count) <- M.toList m] + +parseRuleEntry :: String -> (Pair, Char) +parseRuleEntry s = ((a, b), head $ T.unpack r) + where [t, r] = T.splitOn " -> " (T.pack s) + [a, b] = T.unpack t + +parseFile :: String -> (Map Pair Int, Map Pair Char) +parseFile s = (stringToPairs (T.unpack initial), M.fromList $ map parseRuleEntry rules) + where [initial, rulesSection] = T.splitOn "\n\n" (T.pack s) + rules = lines (T.unpack rulesSection) + + +main :: IO () +main = do + input <- readFile "./input" + let (initial, rules) = parseFile input + let result = foldr (\_ acc -> doSubstitutions rules acc) initial [1..40] + let counts = countLetters result + + let mx = maximum (M.elems counts) + let mi = minimum (M.elems counts) + print (mx, mi) + print $ mx - mi -- cgit v1.2.3