-
Notifications
You must be signed in to change notification settings - Fork 8
/
Day19.hs
97 lines (82 loc) · 2.79 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
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
{-# LANGUAGE OverloadedStrings #-}
-- |
-- Module : AOC.Challenge.Day19
-- License : BSD3
--
-- Stability : experimental
-- Portability : non-portable
--
-- Day 19. See "AOC.Solver" for the types used in this module!
module AOC.Challenge.Day19 (
day19a
, day19b
) where
import AOC.Common (countTrue, pTok)
import AOC.Solver ((:~>)(..))
import Control.Applicative (empty)
import Control.DeepSeq (NFData)
import Control.Monad ((>=>), guard)
import Data.Bifunctor (first)
import Data.Functor.Foldable (hylo)
import Data.IntMap (IntMap)
import Data.Void (Void)
import GHC.Generics (Generic)
import qualified Data.IntMap as IM
import qualified Text.Megaparsec as P
import qualified Text.Megaparsec.Char as P
import qualified Text.Megaparsec.Char.Lexer as PP
data Rule a = Simple Char
| Compound [[a]]
deriving (Show, Eq, Ord, Generic, Functor)
instance NFData a => NFData (Rule a)
matchRuleAlg :: Rule (String -> [String]) -> String -> [String]
matchRuleAlg = \case
Simple c -> \case
[] -> empty
d:ds -> ds <$ guard (c == d)
Compound xs -> \str ->
concatMap (\ys -> foldr (>=>) pure ys str) xs
matcher :: IntMap (Rule Int) -> String -> [String]
matcher rules = hylo matchRuleAlg (rules IM.!) 0
solver :: IntMap (Rule Int) -> [String] -> Int
solver rules = countTrue (any null . matcher rules)
day19a :: (IntMap (Rule Int), [String]) :~> Int
day19a = MkSol
{ sParse = P.parseMaybe inputParser
, sShow = show
, sSolve = Just . uncurry solver
}
day19b :: (IntMap (Rule Int), [String]) :~> Int
day19b = MkSol
{ sParse = sParse day19a
, sShow = show
, sSolve = Just . uncurry solver . first (extraRules <>)
}
extraRules :: IntMap (Rule Int)
extraRules = IM.fromList [
(8 , Compound [[42],[42,8]])
, (11, Compound [[42,31],[42,11,31]])
]
-- for fun: generate all matching strings
_genAlg :: Rule [String] -> [String]
_genAlg = \case
Simple c -> [[c]]
Compound xs -> concatMap (fmap concat . sequence) xs
type Parser' = P.Parsec Void String
ruleParser :: Parser' (Int, Rule Int)
ruleParser = do
i <- pTok $ PP.decimal <* ":"
r <- P.choice
[ P.try $ Simple <$> simpleParser
, Compound <$> compoundParser
]
pure (i, r)
where
simpleParser = P.between "\"" "\"" P.letterChar
compoundParser = P.many (pTok PP.decimal) `P.sepBy` pTok "|"
inputParser :: Parser' (IntMap (Rule Int), [String])
inputParser = do
rs <- IM.fromList <$> P.many (ruleParser <* P.newline)
P.newline
ss <- P.many P.letterChar `P.sepBy` P.newline
pure (rs, ss)