eldridge.cam
Advent of Code solutions
2021:14
+35
2021/14/p1.hs
+35
2021/14/p1.hs
···
1
+
import Control.Arrow
2
+
import Text.Parsec
3
+
import Data.List
4
+
import Data.Map qualified as Map
5
+
6
+
initialize ps = Map.unionsWith (+) $ fmap (flip Map.singleton 1) $ ps `zip` tail ps
7
+
8
+
rule = do
9
+
a:b:_ <- count 2 letter
10
+
string " -> "
11
+
to <- letter
12
+
return $ Map.singleton (a, b) [(a, to), (to, b)]
13
+
14
+
input = do
15
+
initial <- many letter
16
+
count 2 newline
17
+
rules <- rule `endBy` newline
18
+
return (initial, Map.unions rules)
19
+
20
+
step rules state = Map.unionsWith (+) $ do
21
+
(k, v) <- Map.assocs state
22
+
k2 <- rules Map.! k
23
+
return $ Map.singleton k2 v
24
+
25
+
answer contents =
26
+
uncurry (-)
27
+
$ maximum &&& minimum
28
+
$ Map.unionWith (+) (Map.singleton (last initial) 1)
29
+
$ Map.mapKeysWith (+) fst
30
+
$ (!! 10)
31
+
$ iterate (step rules)
32
+
$ initialize initial
33
+
where Right (initial, rules) = parse input "" contents
34
+
35
+
main = getContents >>= print . answer
+35
2021/14/p2.hs
+35
2021/14/p2.hs
···
1
+
import Control.Arrow
2
+
import Text.Parsec
3
+
import Data.List
4
+
import Data.Map qualified as Map
5
+
6
+
initialize ps = Map.unionsWith (+) $ fmap (flip Map.singleton 1) $ ps `zip` tail ps
7
+
8
+
rule = do
9
+
a:b:_ <- count 2 letter
10
+
string " -> "
11
+
to <- letter
12
+
return $ Map.singleton (a, b) [(a, to), (to, b)]
13
+
14
+
input = do
15
+
initial <- many letter
16
+
count 2 newline
17
+
rules <- rule `endBy` newline
18
+
return (initial, Map.unions rules)
19
+
20
+
step rules state = Map.unionsWith (+) $ do
21
+
(k, v) <- Map.assocs state
22
+
k2 <- rules Map.! k
23
+
return $ Map.singleton k2 v
24
+
25
+
answer contents =
26
+
uncurry (-)
27
+
$ maximum &&& minimum
28
+
$ Map.unionWith (+) (Map.singleton (last initial) 1)
29
+
$ Map.mapKeysWith (+) fst
30
+
$ (!! 40)
31
+
$ iterate (step rules)
32
+
$ initialize initial
33
+
where Right (initial, rules) = parse input "" contents
34
+
35
+
main = getContents >>= print . answer