-
Notifications
You must be signed in to change notification settings - Fork 5
/
Day25.hs
73 lines (61 loc) · 2.64 KB
/
Day25.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
module AOC2017.Day25 (day25a) where
import AOC2017.Types (Challenge)
import AOC2017.Util ((!!!))
import Control.Applicative (Applicative(..), Alternative(..))
import Control.Lens.At (Contains(..))
import Control.Monad (replicateM)
import Data.Bifunctor (first)
import Data.Semigroup (Semigroup(..), Last(..), Sum(..))
import Data.Void (Void)
import qualified Data.IntSet as IS
import qualified Data.Map as M
import qualified Text.Megaparsec as P
import qualified Text.Megaparsec.Char as P
import qualified Text.Megaparsec.Char.Lexer as PL
type St = Last Char
type Step = (Sum Int, St)
type RuleMap = M.Map St ((Step, Bool), (Step, Bool))
runRule :: RuleMap -> St -> Bool -> (Step, Bool)
runRule rm st = \case
False -> fst $ rm M.! st
True -> snd $ rm M.! st
step :: RuleMap -> Step -> IS.IntSet -> (Step, IS.IntSet)
step rm s0@(Sum i,st) = first (s0 <>) . contains i (runRule rm st)
day25a :: Challenge
day25a (parse->RS{..}) = show . IS.size . snd . (!!! rsSteps)
. iterate (uncurry (step rsRuleMap))
$ ((0, rsStart), IS.empty)
-- Ugly parser stuff below
data RuleSet = RS { rsStart :: St
, rsSteps :: Int
, rsRuleMap :: RuleMap
}
deriving Show
type Parser = P.Parsec Void String
parse :: String -> RuleSet
parse = either (error . P.parseErrorPretty) id . P.runParser ruleSet ""
ruleSet :: Parser RuleSet
ruleSet = do
st0 <- parseLine "Begin in state" P.anyChar
stp <- parseLine "Perform a diagnostic checksum after" PL.decimal
rules <- many rule
return RS { rsStart = Last st0
, rsSteps = stp
, rsRuleMap = M.fromList rules
}
where
rule :: Parser (Last Char, ((Step, Bool), (Step, Bool)))
rule = do
st <- parseLine "In state" P.anyChar
[r0,r1] <- replicateM 2 $ do
_ <- parseLine "If the current value is" P.anyChar
b <- (== '1')
<$> parseLine "- Write the value" P.anyChar
d <- (\case "left" -> -1; _ -> 1)
<$> parseLine "- Move one slot to the" (P.many P.letterChar)
c <- parseLine "- Continue with state" P.anyChar
return ((Sum d, Last c), b)
return (Last st, (r0, r1))
parseLine :: String -> Parser a -> Parser a
parseLine str = P.between (P.space *> P.string str *> P.space)
(P.skipManyTill P.anyChar P.newline)