-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathDay19.hs
76 lines (65 loc) · 2.56 KB
/
Day19.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
module Day19
( part1
, part2
) where
import Control.Monad (guard, void)
import Data.Char (isDigit)
import Data.Either (fromRight, isRight)
import Data.List.Split (splitWhen)
import Data.Map (Map, fromList, (!))
import Helpers.Parsers (Parser)
import Text.ParserCombinators.ReadP (ReadP, char, choice, eof, get,
many, many1, manyTill, optional,
readP_to_S, satisfy, sepBy,
string, (+++))
type ParserBuilder = Map Int [String]
parse :: ReadP a -> String -> a
parse parser = fst . head . filter ((== "") . snd) . readP_to_S parser
parseBuildLine :: ReadP (Int, [String])
parseBuildLine =
(,) <$> ident <* string ": " <*> choice [numbers, manyNumbers, findChar]
where
ident = read <$> aNumber
numbers = (++) <$> bl <*> fmap (["|"] ++) manyNumbers
bl = sepBy aNumber (char ' ') <* string " | "
manyNumbers = sepBy aNumber (char ' ')
aNumber = many1 (satisfy isDigit)
findChar = fmap (\x -> [[x]]) $ string "\"" *> get <* string "\""
buildParser :: Int -> ParserBuilder -> ReadP ()
buildParser rule builder
| dest == ["a"] = void . char $ 'a'
| dest == ["b"] = void . char $ 'b'
| "|" `elem` dest = createParser a +++ createParser b
| otherwise = createParser dest
where
dest = builder ! rule
[a, b] = splitWhen (== "|") dest
createParser = foldl1 chain . map (\x -> buildParser (read x) builder)
chain a b = do
a
b
countParse :: ReadP a -> [String] -> Int
countParse parser =
length . concatMap (filter ((== "") . snd) . readP_to_S parser)
testMessages :: [[String]] -> Int
testMessages [a, b] = countParse (parser <* eof) b
where
parser = buildParser 0 . fromList . map (parse parseBuildLine) $ a
buildInfiniteParser :: ParserBuilder -> ReadP ()
buildInfiniteParser builder = do
fourtyTwo
r1 <- many1 fourtyTwo
r2 <- many1 thirtyOne
eof
guard $ length r1 >= length r2
where
fourtyTwo = buildParser 42 builder
thirtyOne = buildParser 31 builder
testInfiniteMessages :: [[String]] -> Int
testInfiniteMessages [a, b] = countParse parser b
where
parser = buildInfiniteParser . fromList . map (parse parseBuildLine) $ a
part1 :: Bool -> String -> String
part1 _ = show . testMessages . splitWhen null . lines
part2 :: Bool -> String -> String
part2 _ = show . testInfiniteMessages . splitWhen null . lines