-
Notifications
You must be signed in to change notification settings - Fork 0
/
day_22.Rmd
183 lines (147 loc) · 4.64 KB
/
day_22.Rmd
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
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
# Crab Combat
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
options(crayon.enabled = NULL, # for when rendering on github actions
scipen = 999) # make sure we never print in scientific notation
library(tidyverse)
START_TIME <- Sys.time()
```
This is my attempt to solve [Day 22](https://adventofcode.com/2020/day/22).
```{r load data}
process_file <- function(file) {
read_file(file) %>%
str_trim() %>%
str_remove_all("\r") %>%
str_split("\n\n") %>%
pluck(1) %>%
map(~as.numeric(str_split(.x, "\n")[[1]][-1]))
}
sample <- process_file("samples/day_22_sample.txt")
actual <- process_file("inputs/day_22_input.txt")
```
## Part 1
We can create a function that applies the rules of the game.
```{r part 1 function}
part_1 <- function(input) {
player_1 <- input[[1]]
player_2 <- input[[2]]
# repeat while both players have cards
while(length(player_1) > 0 & length(player_2) > 0) {
# get the first cards for player 1 and player 2
a <- player_1[[1]]
b <- player_2[[1]]
# and remove the first cards
player_1 <- player_1[-1]
player_2 <- player_2[-1]
if (a > b) {
player_1 <- c(player_1, a, b)
} else {
player_2 <- c(player_2, b, a)
}
}
# get the winners cards
r <- if (length(player_1) > 0) {
player_1
} else {
player_2
}
# return the results as required for the puzzle
sum(r * rev(seq_along(r)))
}
```
We can verify that this function returns the correct results against the sample data:
```{r part 1 sample test}
part_1(sample) == 306
```
And we can run the function against our actual data:
```{r part 1 actual}
part_1(actual)
```
## Part 2
Part 2 is a more complex problem. The naive implementation takes a number of minutes to run, but there is a useful
optimisation that
[u/daggerdraggon](https://www.reddit.com/r/adventofcode/comments/khyjgv/2020_day_22_solutions/ggpcsnd/) posted on
Reddit.
```{r}
part_2 <- function(input) {
# create a function that can called recursively
play <- function(player_1, player_2, subgame = FALSE) {
prior_player_1 <- list()
prior_player_2 <- list()
# optimisation from u/daggerdragon on reddit
# https://www.reddit.com/r/adventofcode/comments/khyjgv/2020_day_22_solutions/ggpcsnd/
max_p1 <- max(player_1)
max_p2 <- max(player_2)
if (subgame &&
max_p1 > max_p2 &&
(length(player_1) + length(player_2)) < max_p1) {
return (list(
winner = 1,
players = list(player_1, player_2)
))
}
# repeat while both players have cards
while(length(player_1) > 0 & length(player_2) > 0) {
# create key's to use in the hash of the prior hands seen hashtables
player_1_str <- paste(player_1, collapse = ",")
player_2_str <- paste(player_2, collapse = ",")
# check, if we haven't seen this hand we will get NULL on lookups
# looking up like this is orders of magnitude quicker than using %in%
if (!is.null(prior_player_1[[player_1_str]]) &
!is.null(prior_player_2[[player_2_str]])) {
return (list(
winner = 1,
players = list(player_1, player_2)
))
}
# update the prior seen hashtables
prior_player_1[[player_1_str]] <- TRUE
prior_player_2[[player_2_str]] <- TRUE
# get the first cards for player 1 and player 2
a <- player_1[[1]]
b <- player_2[[1]]
# and remove the first cards
player_1 <- player_1[-1]
player_2 <- player_2[-1]
# check to see if we can play a subgame or not
r <- if (length(player_1) >= a & length(player_2) >= b) {
# return the winner of the subgame
play(player_1[1:a], player_2[1:b], TRUE)$winner
} else if (a > b) {
# player 1 wins
1
} else {
# player 2 wins
2
}
# update the player's hands if they have won
if (r == 1) {
player_1 <- c(player_1, a, b)
} else {
player_2 <- c(player_2, b, a)
}
}
# we have run out of cards for one player, return the results
list(
winner = ifelse(length(player_1) > 0, 1, 2),
players = list(player_1, player_2)
)
}
# start to play the game
p <- play(input[[1]], input[[2]])
# get the results for the winner
w <- p$players[[p$winner]]
# return the results as required for the puzzle
sum(w * rev(seq_along(w)))
}
```
We can test this function on the sample data:
```{r part 2 sample test}
part_2(sample) == 291
```
And we can run this function on the actual data:
```{r part 2 actual}
part_2(actual)
```
---
*Elapsed Time: `r round(Sys.time() - START_TIME, 3)`s*