Advent of Code
It is December, it is christmas time and I recently discovered the advent of code. An Event, made by Eric Wastl. Every day, a new small programming puzzle gets published and every right solution is rewarded with a little star coin. I’m not sure what will happens in the end.
However, I thought it would be fun and a nice topic to restart my blog a little bit. I will merely link to the task and directly write about the the solution and my learning. All scripts can be found in my gitlab repo
Update:
David Robinson just posted his solution on twitter and of course its great. As expected, a clever regex implementation makes it easier to read and shortens the lines of code.
1
2
|
input <- read_csv("2nd Day/Input.csv") %>%
extract(Input, c("min", "max", "letter", "password"), "(\\d+)-(\\d+) (.): *(.*)", convert = TRUE))
|
My main takeaway from his solution is the use of regex. Brackets for every column and a simple regex expression to identify them. I need to go dive deepr into regex and I guess the advent of code will have some opportunities.
During the second task you could see a different thinking on checking password. As I’m searching for every occurence in the
string and then check if it fulfills the requirements, he truncates the password to the necessary length and checks the first and the last letter.
1
2
3
4
|
input %>%
mutate(count = (str_sub(password, min, min) == letter) +
(str_sub(password, max, max) == letter)) %>%
filter(count == 1)
|
Day 2 - Task 1
The target is to check several passwords for its validity. Every password has its own individual requirements, which need to be confirmed or denied.
Here is the Exampe Input, describing the minimum and the maximum amount of letters, the password may consist of:
1
2
3
|
1-3 a: abcde
1-3 b: cdefg
2-9 c: ccccccccc
|
So, first sepearte each requirement, put it inside a data frame, so it is easier to handle.
1
2
3
4
5
|
input <- read_csv("2nd Day/Input.csv") %>%
select(Input) %>%
separate(Input, c("rule", "password"), ": ") %>%
separate(rule, c("range", "letter"), " ") %>%
separate(range, c("min", "max"), "-")
|
This seems way too complicated, lets look up a shorter version afterwards. I guess a more sphisticated approach with regex will be better.
Now that we have everything sorted, it should be easy to check, wether a password fulfills the requirements and count valid entries. I chose the stringr package to do the heavy lifting. str_count() can count the occurence of a letter in a string, which will be comparable afterwards.
1
2
3
4
5
6
7
8
9
|
output_1 <- input %>%
mutate(pw_check = str_count(input$password, paste(input$letter)),
min = as.numeric(min),
max = as.numeric(max)) %>%
mutate(check = ifelse(pw_check > max, "higher",
ifelse(pw_check < min,"lower",
"right")))
table(output$check)
|
Day 2 - Task 2
The second task is an alternation from the first. Now, a password is valied if the minimum and the maximum number both are the given letter. I'’m going to locate every letters position position and see if it matches the requirements.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
|
output_2 <- output_1 %>%
mutate(pw_location = str_locate_all(password, paste(letter)))
output_2$begin <- 0
output_2$end <- 0
output_2$sum <- 0
for (i in 1:nrow(output_2)) {
if (output_2$min[i] %in% output_2$pw_location[[i]][,1]) {
output_2$begin[i] = 1
}
if (output_2$max[i] %in% output_2$pw_location[[i]][,1]) {
output_2$end[i] = 1
}
output_2$sum[i] = output_2$begin[i] + output_2$end[i]
}
table(result$sum)
|
Day number 3 arrived and holds a very well told task about a sleigh ride. How many trees can you catch on your way down. The input is interesting, because it is only a part of the complete Input and needs to be replicated, epending on our needs.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
|
............#....#.........................#....#.........................#....#.
...........##....#......#..#..#...........##....#......#..#..#...........##....#.
......#.......#......#...............#.......#......#...............#.......#....
..#.#....#....#.............##...#.#....#....#.............##...#.#....#....#....
..#........####....#...#.........#........####....#...#.........#........####....
..##.....#.#.#..#.........#......##.....#.#.#..#.........#......##.....#.#.#..#..
...#.#..#..#....#..#..#...........#.#..#..#....#..#..#...........#.#..#..#....#..
#.......#.........#....##.###..#.......#.........#....##.###..#.......#.........#
......##..#.#...#.......#.#..........##..#.#...#.......#.#..........##..#.#...#..
................##.........#.##................##.........#.##................##.
..##..........#...#.........#.#..##..........#...#.........#.#..##..........#...#
..........#...##.........................#...##.........................#...##...
#...#......#..#.#..#...##..#...#...#......#..#.#..#...##..#...#...#......#..#.#..
..##....#.......#......#..#......##....#.......#......#..#......##....#.......#..
....#......#......#....#...........#......#......#....#...........#......#......#
|
So, first, I need to prepare the input and correctly parse it into a data.frame.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
|
# ---- create input ----
Input <- read_csv("3rd Day/Input.csv", col_names = FALSE)
Input_clean <- Input[,1:31]
rm(Input)
count_columns <- ncol(Input_clean)
count_rows <- nrow(Input_clean)
necessary_cols <- 7 * count_rows
necessary_replicaition <- ceiling(necessary_cols / count_columns)
tree_map <- Input_clean
for (i in 1:necessary_replicaition) {
tree_map <- cbind(tree_map, Input_clean)
}
count_map_columns <- ncol(tree_map)
col_names <- as.character(seq(1:count_map_columns))
names(tree_map) <- col_names
|
Day 3 - Task 1
The way down is pre-defined so I simply have to check every cell, whether its a tree (and count it) or not.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
|
col_steps <- seq(1,count_map_columns, by = 3)
row_steps <- seq(1,count_rows)
tree_count <- 0
df_coordinates <- data.frame(rows = row_steps,
cols = col_steps[1:count_rows])
for (i in 1:count_rows) {
row_coordinate = df_coordinates[i,1]
col_coordinate = df_coordinates[i,2]
if (tree_map[row_coordinate,col_coordinate] == '#') {
tree_count <- tree_count + 1
}
}
|
Day 3 - Task 2
Ok, now we have different slopes to take. The easiest approach would be to turn the first solution into a function and map it to each slope.
Finally, using map() again \o/
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
|
tree_counter <- function(right, down) {
col_steps <- seq(1,count_map_columns, by = right)
row_steps <- seq(1,count_rows, by = down)
tree_count <- 0
df_coordinates <- data.frame(rows = row_steps,
cols = col_steps[1:length(row_steps)])
for (i in 1:length(row_steps)) {
#print(i)
row_coordinate = df_coordinates[i,1]
col_coordinate = df_coordinates[i,2]
if (tree_map[row_coordinate,col_coordinate] == '#') {
tree_count <- tree_count + 1
}
}
return(tree_count)
}
tibble_sequence <- tibble(right = c(1,3,5,7,1),
down = c(1,1,1,1,2))
trees_per_route <- tibble_sequence %>%
mutate(trees = unlist(map2(right, down, tree_counter)))
prod(trees_per_route$trees)
|
Ok, Day 5 seems to be about informatics basics. Binary search trees, maybe. Sadly I have no major in CS, so I need to do it with my Data Science skills. Lets see how that goes. The task is to identify my empty seat in a fully occupied aircraft. This happens, based on a numbering system FBFBBFFRLR. The first 7 character indicate an upper or lower half of row number and the later 3 character equally for columns. Nice.
1
2
3
4
5
6
7
8
|
-------------------------- ----------------------- --------------------------|
| | | |ò| | | | | | | |0| | | |O| | | | |o| | | | | | | | | | | | | | |
o o 0 O o o o |
| | | | | | | | | | | | | | | | | |O| | |o| | | | | | | | | | | | | | |
ô | OOOO
| | | |o|ó| | | | | | |0| | | | | | | | |o| | | | | | | | | | | | | | |
-------------------------- ----------------------- --------------------------|
|
Lets read the input and keep an individual column for each character. This should make it easier to navigate later on. Also, I think I should stick to tibbles as it appears to be a more feature rich and tidy approach to problem solving.
1
2
3
4
|
input = tibble(x = readLines("5th Day/input.txt")) %>%
extract(x, as.character(1:10), "(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)", remove = TRUE, convert = TRUE) %>%
mutate(row = 0,
column = 0)
|
Day 5 - Task 1
I guess I will just create a vector of all rows and split it in half and depending on the character, I choose the upper or lower half. The same should for the columns later on.
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
|
for (i in 1:nrow(input)) {
rows = as.vector(seq(0, 127, 1))
for (j in 1:7) {
n_rows = length(rows) / 2
factor_vector = c(rep(1, n_rows), rep(2, n_rows))
split_rows <- split(rows, factor_vector)
if (input[i,j] == "F") {
rows = split_rows$`1`
} else {rows = split_rows$`2`}
}
input[i, 11] <- rows
}
for (i in 1:nrow(input)) {
cols = as.vector(seq(0, 7, 1))
for (j in 8:10) {
n_cols = length(cols) / 2
factor_vector = c(rep(1, n_cols), rep(2, n_cols))
split_cols <- split(cols, factor_vector)
if (input[i,j] == "L") {
cols = split_cols$`1`
} else {cols = split_cols$`2`}
}
input[i, 12] <- cols
}
|
This checks out. The demanded “Sanity Checks” should be easy, so I can simply select the highest Seat-ID
1
2
3
4
5
6
|
input %>%
mutate(sanity = row * 8 + column) %>%
arrange(desc(sanity)) %>%
select(sanity) %>%
head(1)
|
Day 5 - Task 2
Task 2 is all about finding my own seat. First and last row drops out by definition and all remaining seats are supposed to be occupied. Hence, I can filter for the only row with 7 seats and I should find the solution. Great!
1
2
3
4
5
6
|
my_row <- input %>%
group_by(row) %>%
summarise(n = n()) %>%
filter(n == 7) %>%
select(row) %>%
as.numeric()
|
It’s Nikolaus Day and our adventofcode protagonist is about to arrive, after a long flight. But not without filing everyones customs declaration forms.
Here is an input sample:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
|
mxuwh
hwuxm
uhxmw
hwumx
hwuxm
k
k
tl
k
qebagdfvhr
alvkif
yufaovwi
fivsa
nwifazovu
|
Day 6 - Task 1
Every blank line means a new group, every line a person and every letter a yes for a question between A-Z. We want to know what questions each group answered yes to, independently of an individual person. Only groups matter.
So lets load the tidyverse, summarise every group and return distinct values.
And yes, the cumsum(x == "") command is inspired by a previous solution from David Robinson.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
|
str_unique <- function(x) paste(unique(strsplit(x, "")[[1]]), collapse = "")
input = tibble(x = readLines("6th Day/input.txt")) %>%
mutate(group = cumsum(x== "")) %>%
filter(str_detect(x, "."))
#---- Taks 1 ----
answers <- input %>%
group_by(group) %>%
summarise(answers = paste(x,collapse = "")) %>%
mutate(answers_unique = map(answers, str_unique),
answers_count = str_count(answers_unique))
result_t1 = colSums(answers[,4])
print(result_t1)
|
Day 6 - Task 2
Shoot, of course there was a misread. I’m not supposed to count an answer, where anyone of a group answered yes, but where everyone of the group answered yes.
So I don’t need distinct values, but something like common values.
I found a nice solution to identify common elements between multiple lists. This is something I should put in a functin, so it is applicable in a map() function.
reduce() enables me, to use the intersect() function on more than two paramter.
1
|
common_f <- function(x) paste(reduce(x, intersect), collapse = "")
|
Then I can transform the input in grouped lists of individual characters and look for common elements.
1
2
3
4
5
6
7
8
9
|
answers_2 <- input %>%
mutate(x = str_split(x, "")) %>%
group_by(group) %>%
summarise(answers = list(x)) %>%
mutate(answers_common = map(answers, common_f),
answers_count = str_count(answers_common))
result_t2 = colSums(answers_2[,4])
print(result_t2)
|
Resting from Work
During the flight our protagnosists helps rapairing a game boy, which is stuck in an infinite loop. So lets take a look at the instruction set and see where the commands start to repeat themselves.
Day 8 - Task 1
I will run through the instruction set and assign a 1 to every row, which already has been executed. I one instruction is repeated, I stop and check the accumulation value, as demanded by the task.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
|
library(tidyverse)
input <- tibble(x = readLines("8th Day/input.txt")) %>%
separate(x, c("command", "value"), "\\s") %>%
mutate(value = as.numeric(value),
counter = 0)
accumulator = 0
i = 1
while (input$counter[i] == 0 & i < 643) {
input$counter[i] <- 1
cmd_i = input$command[i]
value_i = input$value[i]
if (cmd_i == "acc") {
accumulator <- accumulator + value_i
i = i + 1
} else if (cmd_i == "jmp") {
i <- value_i + i
} else {
i = i + 1
}
}
|
Day 8 - Task 2
Next, it is time to correct the program. The assumption is, that either one acc or jmp command needs to be exchanged with each other. I guess I will just brute force myself out of this situation, exchange every command one after the other and see if the code finishes. I can determine success if the last command has been executed. Interestingly, the last command is a jump to the first command and would be another loop in itself. So I don’t wait until the program finishes, but have to explicitly check, whether the command has been executed. Go!
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
|
input_or <- tibble(x = readLines("8th Day/input.txt")) %>%
separate(x, c("command", "value"), "\\s") %>%
mutate(value = as.numeric(value),
counter = 0)
for (k in seq_along(input_or$command)) {
input <- input_or
accumulator = 0
success_check = 0
print(k)
if (input$command[k] == "jmp") {
input$command[k] <- "nop"
} else if (input$command[k] == "nop") {
input$command[k] <- "jmp"
} else {
next()
}
i = 1
while (input$counter[i] == 0 & i < 643) {
input$counter[i] <- 1
cmd_i = input$command[i]
value_i = input$value[i]
if (cmd_i == "acc") {
accumulator <- accumulator + value_i
i = i + 1
} else if (cmd_i == "jmp") {
i <- value_i + i
} else {
i = i + 1
}
if (i == 643) {
success_check = 1
print(paste("Success", accumulator))
}
}
if(success_check == 1){
break()
}
}
|
That was a really fun Puzzle. Looking forward to tomorrow.