aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJulien Dessaux2023-04-12 02:35:10 +0200
committerJulien Dessaux2023-04-12 02:35:10 +0200
commitee4fa81423332f41254cd7ffd8ccc95a4fc7bae1 (patch)
tree2f46ad4cab3e1cdf025f85f1b653d9854a38637e
parent2020-19 part 1 in haskell (diff)
downloadadvent-of-code-ee4fa81423332f41254cd7ffd8ccc95a4fc7bae1.tar.gz
advent-of-code-ee4fa81423332f41254cd7ffd8ccc95a4fc7bae1.tar.bz2
advent-of-code-ee4fa81423332f41254cd7ffd8ccc95a4fc7bae1.zip
2020-19 part 2 in haskell
Diffstat (limited to '')
-rw-r--r--2020/19-Monster_Messages/example247
-rw-r--r--2020/19-Monster_Messages/second.hs90
2 files changed, 137 insertions, 0 deletions
diff --git a/2020/19-Monster_Messages/example2 b/2020/19-Monster_Messages/example2
new file mode 100644
index 0000000..8c931b1
--- /dev/null
+++ b/2020/19-Monster_Messages/example2
@@ -0,0 +1,47 @@
+42: 9 14 | 10 1
+9: 14 27 | 1 26
+10: 23 14 | 28 1
+1: "a"
+11: 42 31
+5: 1 14 | 15 1
+19: 14 1 | 14 14
+12: 24 14 | 19 1
+16: 15 1 | 14 14
+31: 14 17 | 1 13
+6: 14 14 | 1 14
+2: 1 24 | 14 4
+0: 8 11
+13: 14 3 | 1 12
+15: 1 | 14
+17: 14 2 | 1 7
+23: 25 1 | 22 14
+28: 16 1
+4: 1 1
+20: 14 14 | 1 15
+3: 5 14 | 16 1
+27: 1 6 | 14 18
+14: "b"
+21: 14 1 | 1 14
+25: 1 1 | 1 14
+22: 14 14
+8: 42
+26: 14 22 | 1 20
+18: 15 15
+7: 14 5 | 1 21
+24: 14 1
+
+abbbbbabbbaaaababbaabbbbabababbbabbbbbbabaaaa
+bbabbbbaabaabba
+babbbbaabbbbbabbbbbbaabaaabaaa
+aaabbbbbbaaaabaababaabababbabaaabbababababaaa
+bbbbbbbaaaabbbbaaabbabaaa
+bbbababbbbaaaaaaaabbababaaababaabab
+ababaaaaaabaaab
+ababaaaaabbbaba
+baabbaaaabbaaaababbaababb
+abbbbabbbbaaaababbbbbbaaaababb
+aaaaabbaabaaaaababaa
+aaaabbaaaabbaaa
+aaaabbaabbaaaaaaabbbabbbaaabbaabaaa
+babaaabbbaaabaababbaabababaaab
+aabbbbbaabbbaaaaaabbbbbababaaaaabbaaabba
diff --git a/2020/19-Monster_Messages/second.hs b/2020/19-Monster_Messages/second.hs
new file mode 100644
index 0000000..04a0049
--- /dev/null
+++ b/2020/19-Monster_Messages/second.hs
@@ -0,0 +1,90 @@
+-- requires cabal install --lib megaparsec parser-combinators
+module Main (main) where
+import Control.Monad (void, when)
+import Data.Either
+import Data.List (any, foldl')
+import Data.Maybe (catMaybes)
+import Data.Map qualified as M
+import Data.Void (Void)
+import Text.Megaparsec
+import Text.Megaparsec.Char
+import System.Exit (die)
+
+exampleExpectedOutput = 12
+
+type Match = Char
+type RuleID = Int
+type Action = [RuleID]
+type Rule = Either Match [Action]
+type Message = String
+data Input = Input { rules :: M.Map RuleID Rule
+ , messages :: [Message]
+ } deriving (Show)
+
+type Parser = Parsec Void String
+
+parseInt :: Parser Int
+parseInt = do
+ n <- some digitChar
+ void $ optional (char ' ')
+ return $ read n
+
+parseMatch :: Parser Match
+parseMatch = do
+ void $ char '"'
+ c <- letterChar
+ void $ char '"'
+ return c
+
+parseAction :: Parser Action
+parseAction = some (parseInt <* optional (char ' '))
+
+parseRule :: Parser (RuleID, Rule)
+parseRule = do
+ id <- some digitChar
+ void $ string ": "
+ rule <- (Left <$> parseMatch) <|> (Right <$> some (parseAction <* optional (string "| ")))
+ void $ char '\n'
+ return $ (read id, rule)
+
+parseInput' :: Parser Input
+parseInput' = do
+ rules <- M.fromList <$> some parseRule
+ void $ char '\n'
+ messages <- some (some letterChar <* (optional $ char '\n'))
+ void eof
+ let rules' = M.insert 8 (Right $ reverse [take i (repeat 42)|i<-[1..5]]) rules
+ rules'' = M.insert 11 (Right $ reverse [take i (repeat 42) ++ take i (repeat 31)|i<-[1..5]]) rules'
+ return $ Input rules'' messages
+
+parseInput :: String -> IO Input
+parseInput filename = do
+ input <- readFile filename
+ case runParser parseInput' filename input of
+ Left bundle -> die $ errorBundlePretty bundle
+ Right input' -> return input'
+
+compute :: Input -> Int
+compute (Input rules messages) = length . filter id $ map isValid messages
+ where
+ isValid :: Message -> Bool
+ isValid msg = any (== "") $ matchAll 0 [msg]
+ matchAll :: RuleID -> [Message] -> [Message]
+ matchAll ruleId msgs = concat $ map (matches ruleId) msgs
+ matches :: RuleID -> Message -> [Message]
+ matches _ [] = []
+ matches ruleId msg = case rules M.! ruleId of
+ Left c -> if head msg == c then [tail msg] else []
+ Right actions -> concat $ map (processAction msg) actions
+ processAction :: Message -> Action -> [Message]
+ processAction msg action = foldl' step [msg] action
+ step :: [Message] -> RuleID -> [Message]
+ step msgs ruleID = matchAll ruleID msgs
+
+main :: IO ()
+main = do
+ example <- parseInput "example2"
+ let exampleOutput = compute example
+ when (exampleOutput /= exampleExpectedOutput) (die $ "example failed: got " ++ show exampleOutput ++ " instead of " ++ show exampleExpectedOutput)
+ input <- parseInput "input"
+ print $ compute input