# Day 1

## Part 1

``````input <- scan("2021/01-input")

sum(diff(input) > 0)``````
``0.002 sec elapsed``

## Part 2

``````input <- scan("2021/01-input")

sum3 <- slider::slide_dbl(input, mean, .before = 2)

sum(diff(sum3) > 0)

# Simpler solution thanks to https://twitter.com/trang1618
# This works because `lag` happens to use the same direction
# as `.before`
#
# sum(diff(input, lag = 3) > 0)``````
``0.044 sec elapsed``

# Day 2

## Part 1

``````input <- read.delim("2021/02-input", sep = " ", header = FALSE)

horizontal <- 0
depth <- 0

for (i in seq_len(nrow(input))) {
command <- input[i, 1]
value <- input[i, 2]
if (command == "forward") {
horizontal <- horizontal + value
}
if (command == "up") {
depth <- depth - value
}
if (command == "down") {
depth <- depth + value
}
}

depth * horizontal``````
``0.04 sec elapsed``

## Part 2

``````input <- read.delim("2021/02-input", sep = " ", header = FALSE)

horizontal <- 0
depth <- 0
aim <- 0

for (i in seq_len(nrow(input))) {
command <- input[i, 1]
value <- input[i, 2]
if (command == "forward") {
horizontal <- horizontal + value
depth <- depth + aim * value
}
if (command == "up") {
aim <- aim - value
}
if (command == "down") {
aim <- aim + value
}
}

depth * horizontal``````
``0.037 sec elapsed``

# Day 3

## Part 1

``````input <- readLines("2021/03-input") |>
strsplit("") |>
purrr::reduce(rbind)

common_finder <- function(x, fun, even) {
tab <- table(x)
if (length(tab) == 2 & tab[1] == tab[2]) return(even)
names(which(fun(tab) == tab))
}

rate_calculator <- function(mat, fun, even) {
apply(mat, MARGIN = 2, FUN = common_finder, fun, even) |>
paste0(collapse = "") |>
strtoi(base = 2)
}

gamma <- rate_calculator(input, max, "1")

epsilon <- rate_calculator(input, min , "0")

gamma * epsilon``````
``0.088 sec elapsed``

## Part 2

``````input <- readLines("2021/03-input") |>
strsplit("") |>
purrr::reduce(rbind)

common_finder <- function(x, fun, even) {
tab <- table(x)
if (length(tab) == 2 & tab[1] == tab[2]) return(even)
names(which(fun(tab) == tab))
}

rate_calculator <- function(mat, fun, even) {
considered <- !logical(nrow(mat))

res <- c()

for (i in seq_len(ncol(mat))) {
top <- common_finder(mat[considered, i], fun, even)
res <- c(res, top)
considered <- considered & (mat[, i] == top)

if (sum(considered) == 1) break
}

mat[considered, ] |>
paste0(collapse = "") |>
strtoi(base = 2)
}

oxygen <- rate_calculator(input, max, "1")
co2 <- rate_calculator(input, min, "0")

oxygen * co2``````
``0.078 sec elapsed``

# Day 4

The only difference between part 1 and 2 is that part 1 uses `min(win_times)` and part 2 uses `max(win_times)`

## Part 1

``````input <- readLines("2021/04-input")

read_matrix <- function(lines, sep = "", type = identity) {
lines <- stringr::str_trim(lines)
tokens <- strsplit(lines, sep)
token_lengths <- lengths(tokens)
res <- matrix(nrow = length(lines), ncol = max(token_lengths))

for (i in seq_along(lines)) {
res[i, seq_len(token_lengths[i])] <- type(tokens[[i]])
}
res
}

numbers <- strsplit(input[1], ",")[[1]] |> as.integer()

boards <- purrr::map(
0:99,
~ read_matrix(input[3:7 + 6 * .x], "\\s+", type = as.integer)
)

check_board <- function(board) {
for (i in seq_along(numbers)) {
matched <- matrix(board %in% numbers[seq_len(i)], nrow = 5)

row_checks <- apply(matched, MARGIN = 1, prod)
col_checks <- apply(matched, MARGIN = 2, prod)
if (any(c(row_checks, col_checks) == 1)) break
}
i
}

win_times <- purrr::map_int(boards, check_board)

fastest_time <- min(win_times)
fastest_board <- boards[[which(win_times == fastest_time)]]

sum(setdiff(fastest_board, numbers[seq_len(fastest_time)])) *
numbers[fastest_time]``````
``0.503 sec elapsed``

## Part 2

``````input <- readLines("2021/04-input")

read_matrix <- function(lines, sep = "", type = identity) {
lines <- stringr::str_trim(lines)
tokens <- strsplit(lines, sep)
token_lengths <- lengths(tokens)
res <- matrix(nrow = length(lines), ncol = max(token_lengths))

for (i in seq_along(lines)) {
res[i, seq_len(token_lengths[i])] <- type(tokens[[i]])
}
res
}

numbers <- strsplit(input[1], ",")[[1]] |> as.integer()

boards <- purrr::map(
0:99,
~ read_matrix(input[3:7 + 6 * .x], "\\s+", type = as.integer)
)

check_board <- function(board) {
for (i in seq_along(numbers)) {
matched <- matrix(board %in% numbers[seq_len(i)], nrow = 5)

row_checks <- apply(matched, MARGIN = 1, prod)
col_checks <- apply(matched, MARGIN = 2, prod)
if (any(c(row_checks, col_checks) == 1)) break
}
i
}

win_times <- purrr::map_int(boards, check_board)

slowest_time <- max(win_times)
slowest_board <- boards[[which(win_times == slowest_time)]]

sum(setdiff(slowest_board, numbers[seq_len(slowest_time)])) *
numbers[slowest_time]``````
``0.467 sec elapsed``

# Day 5

This is one of the weird days where part 2 solution is simpler than part 1. Simple delete the first `filter()` call.

## Part 1

``````library(tidyverse)

separate(input, into = c("x1", "y1", "x2", "y2"), convert = TRUE) %>%
filter(x1 == x2 | y1 == y2) %>%
group_nest(row_number()) %>%
mutate(crosses = map(data, ~tibble(x = .x\$x1:.x\$x2, y = .x\$y1:.x\$y2))) %>%
unnest(crosses) %>%
count(x, y) %>%
filter(n > 1) %>%
nrow()``````
``2.235 sec elapsed``

## Part 2

``````library(tidyverse)

separate(input, into = c("x1", "y1", "x2", "y2"), convert = TRUE) %>%
group_nest(row_number()) %>%
mutate(crosses = map(data, ~tibble(x = .x\$x1:.x\$x2, y = .x\$y1:.x\$y2))) %>%
unnest(crosses) %>%
count(x, y) %>%
filter(n > 1) %>%
nrow()``````
``2.259 sec elapsed``

# Day 6

## Part 1

``````input <- scan("2021/06-input", sep = ",")

for (i in seq_len(80)) {
input <- input - 1
if (any(input < 0)) {
input <- c(input, rep(8, sum(input < 0)))
input[input < 0] <- 6
}
}

length(input)``````
``0.12 sec elapsed``

## Part 2

``````input <- scan("2021/06-input", sep = ",")

counts <- c(0, tabulate(input, nbins = 8))

for (i in seq_len(256)) {
n0 <- counts[1]
counts[-length(counts)] <- counts[-1]
counts[7] <- counts[7] + n0
counts[9] <- n0
}

options(scipen = 999)
sum(counts)``````
``0.017 sec elapsed``

# Day 7

## Part 1

``````input <- scan("2021/07-input", sep = ",")

values <- seq(min(input), max(input))

fuels <- purrr::map_dbl(values, ~ sum(abs(input - .x)))
min(fuels)

sum(abs(median(input) - input))``````
``0.02 sec elapsed``

## Part 2

``````input <- scan("2021/07-input", sep = ",")

values <- seq(min(input), max(input))

adjust <- function(n) n * (n + 1) / 2

fuels <- purrr::map_dbl(values, ~sum(adjust(abs(input - .x))))
min(fuels)

min(
)``````
``0.067 sec elapsed``

# Day 8

## Part 1

``````library(tidyverse)

str_remove(".*\\| ") %>%
str_split(" ") %>%
map(nchar) %>%
map_int(~length(.x[.x %in% c(2, 4, 3, 7)])) %>%
sum()``````
``0.007 sec elapsed``

## Part 2

``````library(tidyverse)

splitter <- function(x) {
str_split(x, " ") %>%
map(str_split, "") %>%
map(map, sort)
}

setdiff_length <- function(x, y) {
lengths(map(x, ~setdiff(x[[which(y)]], .x)))
}

minus1 <- function(x) x - 1

solver <- function(lights, right) {
x1 <- lengths(lights) == 2
x4 <- lengths(lights) == 4
x7 <- lengths(lights) == 3
x8 <- lengths(lights) == 7
x6 <- lengths(lights) == 6 & setdiff_length(lights, x1) == 1
x0 <- lengths(lights) == 6 & setdiff_length(lights, x4) == 1 & !x6
x9 <- lengths(lights) == 6 & !x6 & !x0
x5 <- lengths(lights) == 5 & setdiff_length(lights, x6) == 1
x3 <- lengths(lights) == 5 & setdiff_length(lights, x9) == 1 & !x5
x2 <- lengths(lights) == 5 & !x5 & !x3

cont <- list(x0, x1, x2, x3, x4, x5, x6, x7, x8, x9) %>%
map(~lights[[which(.x)]]) %>%
map(sort)

right %>%
match(cont) %>%
minus1() %>%
paste(collapse = "") %>%
as.numeric()
}

tibble(input) %>%
separate(input, c("left", "right"), sep = " \\| ") %>%
mutate(across(c("left", "right"), splitter)) %>%
mutate(res = map2_dbl(left, right, solver)) %>%
summarise(total = sum(res))``````
``0.443 sec elapsed``

# Day 9

## Part 1

``````library(purrr)

strsplit("") |>
map(as.integer) |>
reduce(rbind)

row_length <- nrow(input)
col_length <- ncol(input)

mat <- matrix(FALSE, row_length, col_length)

for (row in 1:row_length) {
for (col in 1:col_length) {
row_id <- c(row + 1, row, row - 1, row)
col_id <- c(col, col + 1, col, col - 1)

subset <- !(row_id > row_length | col_id > col_length)

row_id <- row_id[subset]
col_id <- col_id[subset]

if (all(input[cbind(row_id, col_id)] > input[row, col])) {
mat[row, col] <- TRUE
}
}
}

sum(input[mat] + 1)``````
``0.127 sec elapsed``

## Part 2

``````library(purrr)

strsplit("") |>
map(as.integer) |>
reduce(rbind)

row_length <- nrow(input)
col_length <- ncol(input)

mat <- matrix(FALSE, row_length, col_length)

for (row in 1:row_length) {
for (col in 1:col_length) {
row_id <- c(row + 1, row, row - 1, row)
col_id <- c(col, col + 1, col, col - 1)

subset <- !(row_id > row_length | col_id > col_length)

row_id <- row_id[subset]
col_id <- col_id[subset]

if (all(input[cbind(row_id, col_id)] > input[row, col])) {
mat[row, col] <- TRUE
}
}
}

around <- function(row, col) {
list(
list(row = row + 0, col = col + 1),
list(row = row + 1, col = col + 0),
list(row = row + 0, col = col - 1),
list(row = row - 1, col = col + 0)
)
}

range_checker <- function(can) {
!((can\$row == 0) |
(can\$row > row_length) |
(can\$col == 0) |
(can\$col > col_length))
}

value_checker <- function(can, ref) {
value <- input[can\$row, can\$col]
last_value <- input[ref\$row, ref\$col]

if (value == 9) return(FALSE)
value > last_value
}

basin_size <- function(x) {

candidates <- list(
list(row = x[1], col = x[2])
)

saved <- list()

repeat {
new_candidaes <- around(candidates[[1]]\$row, candidates[[1]]\$col)
new_candidaes <- setdiff(new_candidaes, saved)
new_candidaes <- setdiff(new_candidaes, candidates)
new_candidaes <- new_candidaes[map_lgl(new_candidaes, range_checker)]

new_candidaes <- new_candidaes[
map_lgl(new_candidaes, value_checker, candidates[[1]])
]

candidates <- c(candidates, new_candidaes)
saved <- c(saved, candidates[1])
candidates[1] <- NULL

if (length(candidates) == 0) break
}
length(saved)
}

largest_basins <- which(mat, arr.ind = TRUE) |>
apply(1, basin_size)

sort(largest_basins, decreasing = TRUE)[1:3] |>
prod()``````
``3.098 sec elapsed``

# Day 10

## Part 1

``````library(stringr)
library(purrr)

full_pair <- c("\\(\\)" = "", "\\[\\]" = "", "\\{\\}" = "", "<>" = "")

remove_all_pairs <- function(x) {
old <- x
repeat {
new <- str_replace_all(old, full_pair)
if (old == new) break
old <- new
}
old
}

pair_side <- c(
"\\(" = "L", "\\[" = "L", "\\{" = "L", "<" = "L",
"\\)" = "R", "\\]" = "R", "\\}" = "R", ">" = "R"
)

find_corrupted_pair <- function(x) {
value <- str_replace_all(x, pair_side)
loc <- str_locate(value, "LR")
if (is.na(loc[2])) return(NA)
str_sub(x, loc[2], loc[2])
}

cleaned_errors <- map_chr(input, remove_all_pairs)
corrupt <- map_chr(cleaned_errors, find_corrupted_pair)

c(")"= 3, "]" = 57, "}" = 1197, ">" = 25137)[corrupt] |>
sum(na.rm = TRUE)``````
``0.223 sec elapsed``

## Part 2

``````library(stringr)
library(purrr)

full_pair <- c("\\(\\)" = "", "\\[\\]" = "", "\\{\\}" = "", "<>" = "")

remove_all_pairs <- function(x) {
old <- x
repeat {
new <- str_replace_all(old, full_pair)
if (old == new) break
old <- new
}
old
}

pair_side <- c(
"\\(" = "L", "\\[" = "L", "\\{" = "L", "<" = "L",
"\\)" = "R", "\\]" = "R", "\\}" = "R", ">" = "R"
)

find_corrupted_pair <- function(x) {
value <- str_replace_all(x, pair_side)
loc <- str_locate(value, "LR")
if (is.na(loc[2])) return(NA)
str_sub(x, loc[2], loc[2])
}

cleaned_errors <- map_chr(input, remove_all_pairs)
corrupt <- map_chr(cleaned_errors, find_corrupted_pair)

incomplete <- cleaned_errors[is.na(corrupt)]

complete_error <- function(x) {
score <- 0
repeat {
last <- str_sub(x, -1, -1)
pat_com <- c("(" = ")", "[" = "]", "{" = "}", "<" = ">")
score <- score * 5 + match(last, names(pat_com))
x <- paste0(x, pat_com[last])
x <- remove_all_pairs(x)
if (x == "") break
}
score
}

incomplete %>%
map_dbl(complete_error) %>%
median()``````
``0.456 sec elapsed``

# Day 11

## Part 1

``````input <- readLines("2021/11-input") |>
strsplit("") |>
map(as.integer) |>
reduce(rbind)

size <- nrow(input)

around <- function(x) {
row <- x[1]
col <- x[2]
row_id <- c(row - 1, row - 1, row - 1, row, row + 1, row + 1, row + 1, row)
col_id <- c(col - 1, col, col + 1, col + 1, col + 1, col, col - 1, col - 1)
subset <- !(row_id > size | col_id > size)
cbind(row_id[subset], col_id[subset])
}

flashes <- 0

for (i in 1:100) {
flashed <- matrix(FALSE, nrow = size, ncol = size)
input <- input + 1

repeat {
new_flashes <- which((input * !flashed) > 9, arr.ind = TRUE)

if (nrow(new_flashes) == 0) break

flashed <- flashed | (input > 9)

bursts <- map(seq_len(nrow(new_flashes)), ~around(new_flashes[.x, ])) |>
purrr::reduce(rbind)

for (i in seq_len(nrow(bursts))) {
input[bursts[i, 1], bursts[i, 2]] <- input[bursts[i, 1], bursts[i, 2]] + 1
}
}
input[flashed] <- 0
flashes <- flashes + sum(flashed)
}

flashes``````
``0.29 sec elapsed``

## Part 2

``````input <- readLines("2021/11-input") |>
strsplit("") |>
map(as.integer) |>
reduce(rbind)

size <- nrow(input)

around <- function(x) {
row <- x[1]
col <- x[2]
row_id <- c(row - 1, row - 1, row - 1, row, row + 1, row + 1, row + 1, row)
col_id <- c(col - 1, col, col + 1, col + 1, col + 1, col, col - 1, col - 1)
subset <- !(row_id > size | col_id > size)
cbind(row_id[subset], col_id[subset])
}

step <- 0
repeat {
step <- step + 1
flashed <- matrix(FALSE, nrow = size, ncol = size)
input <- input + 1

repeat {
new_flashes <- which((input * !flashed) > 9, arr.ind = TRUE)

if (nrow(new_flashes) == 0) break

flashed <- flashed | (input > 9)

bursts <- map(seq_len(nrow(new_flashes)), ~around(new_flashes[.x, ])) |>
purrr::reduce(rbind)

for (i in seq_len(nrow(bursts))) {
input[bursts[i, 1], bursts[i, 2]] <- input[bursts[i, 1], bursts[i, 2]] + 1
}
}
input[flashed] <- 0

if(all(flashed)) break
}

step``````
``0.919 sec elapsed``

# Day 12

``````library(tidyverse)

input <- tibble(input = readLines("2021/12-input")) %>%
separate(input, into = c("from", "to"))

input <- bind_rows(
input,
input %>% mutate(tmp = from, from = to, to = tmp) %>% select(-tmp)
)

last <- function(x) x[length(x)]

last_x <- last(x)
if (last_x == "end") return(list(x))
new_steps <- input\$to[input\$from == last_x]

map(new_steps, ~c(x, .x))
}

is_correct <- function(x) {
if (length(x) > 1 & last(x) == "start") return(FALSE)
x <- x[!x %in% c("end", "start")]
tab <- table(x)
tab_names <- names(tab)
small <- str_to_lower(tab_names) == tab_names
all(tab[small] == 1)
}

validate_path <- function(x) {
keep(x, is_correct)
}

grow <- function(x) {
x %>%
flatten() %>%
validate_path()
}

old <- list()
old[[1]] <- "start"

repeat {
new <- grow(old)

if (identical(old, new)) break
old <- new
}

length(old)``````
``9.098 sec elapsed``

## Part 2

``````library(tidyverse)

input <- tibble(input = readLines("2021/12-input")) %>%
separate(input, into = c("from", "to"))

input <- bind_rows(
input,
input %>% mutate(tmp = from, from = to, to = tmp) %>% select(-tmp)
)

is_lower <- function(x) tolower(x) == x

paths <- function(current, seen, duplicate) {
if (current == "end") {
return(1)
}
if (current == "start" & !is.null(seen)) {
return(0)
}
if (is_lower(current) & current %in% seen) {
if (is.null(duplicate)) {
duplicate <- current
} else {
return(0)
}
}
seen <- c(seen, current)
out <- 0
out <- out + paths(i, seen, duplicate)
}
out
}

paths(current = "start", seen = NULL, duplicate = NULL)``````
``6.642 sec elapsed``

# Day 13

``````library(tidyverse)

mid <- which(input == "")

p1 <- function(x) x + 1L

folds <- input[seq(mid + 1, length(input))]
points <- input[seq_len(mid - 1)] %>%
str_split(",") %>%
map(as.integer) %>%
map(p1)

mat <- matrix(
FALSE,
nrow = points %>% map_int(~.x[2]) %>% max(),
ncol = points %>% map_int(~.x[1]) %>% max()
)

for (point in points) {
mat[point[[2]], point[[1]]] <- TRUE
}

fold <- folds[1]

axis <- str_extract(fold, "[xy]")
amount <- str_extract(fold, "[0-9]+") %>% as.integer() %>% p1()

if (axis == "y") {
folded <- seq(nrow(mat), amount + 1)
landed <- seq(amount - length(folded), amount - 1)

mat[landed, ] <- mat[landed, ] | mat[folded, ]
mat <- mat[seq_len(amount - 1), ]
} else {
folded <- seq(ncol(mat), amount + 1)
landed <- seq(amount - length(folded), amount - 1)

mat[, landed] <- mat[, landed] | mat[, folded]
mat <- mat[, seq_len(amount - 1)]
}

sum(mat)``````
``0.031 sec elapsed``

## Part 2

``````library(tidyverse)

mid <- which(input == "")

p1 <- function(x) x + 1L

folds <- input[seq(mid + 1, length(input))]
points <- input[seq_len(mid - 1)] %>%
str_split(",") %>%
map(as.integer) %>%
map(p1)

mat <- matrix(
FALSE,
nrow = points %>% map_int(~.x[2]) %>% max(),
ncol = points %>% map_int(~.x[1]) %>% max()
)

for (point in points) {
mat[point[[2]], point[[1]]] <- TRUE
}

for (fold in folds) {
axis <- str_extract(fold, "[xy]")
amount <- str_extract(fold, "[0-9]+") %>% as.integer() %>% p1()

if (axis == "y") {
folded <- seq(nrow(mat), amount + 1)
landed <- seq(amount - length(folded), amount - 1)

mat[landed, ] <- mat[landed, ] | mat[folded, ]
mat <- mat[seq_len(amount - 1), ]
} else {
folded <- seq(ncol(mat), amount + 1)
landed <- seq(amount - length(folded), amount - 1)

mat[, landed] <- mat[, landed] | mat[, folded]
mat <- mat[, seq_len(amount - 1)]
}
}

reshape2::melt(mat) %>%
ggplot(aes(Var2, -Var1, fill = value)) +
geom_raster()``````
``0.076 sec elapsed``

# Day 14

The only difference here between part 1 and part 2 is setting the step range from 10 to 40

``````library(tidyverse)

from <- str_sub(pairs, 1, 2)

adj <- map(pairs, ~ c(paste0(str_sub(.x, 1, 1), str_sub(.x, -1, -1)),
paste0(str_sub(.x, -1, -1), str_sub(.x, 2, 2))))

ref_counts <- counts <- set_names(integer(length(from)), from)
for (i in seq(1, nchar(template) - 1)) {
pair <- str_sub(template, i, i + 1)
counts[pair] <- counts[pair] + 1
}

for (step in 1:10) {
new_counts <- ref_counts
for (pair in names(new_counts)) {
}
counts <- new_counts
}

tibble(
count = c(counts, 1),
char = c(str_sub(names(counts), 1, 1), str_sub(template, -1, -1))
) %>%
count(char, wt = count, sort = TRUE) %>%
summarise(max(n) - min(n))``````
``0.076 sec elapsed``

## Part 2

``````library(tidyverse)

from <- str_sub(pairs, 1, 2)

adj <- map(pairs, ~ c(paste0(str_sub(.x, 1, 1), str_sub(.x, -1, -1)),
paste0(str_sub(.x, -1, -1), str_sub(.x, 2, 2))))

ref_counts <- counts <- set_names(integer(length(from)), from)
for (i in seq(1, nchar(template) - 1)) {
pair <- str_sub(template, i, i + 1)
counts[pair] <- counts[pair] + 1
}

for (step in 1:40) {
new_counts <- ref_counts
for (pair in names(new_counts)) {
}
counts <- new_counts
}

tibble(
count = c(counts, 1),
char = c(str_sub(names(counts), 1, 1), str_sub(template, -1, -1))
) %>%
count(char, wt = count, sort = TRUE) %>%
summarise(max(n) - min(n))``````
``0.079 sec elapsed``