My 2021 Solutions

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)

tibble(input = readLines("2021/05-input")) %>%
  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)

tibble(input = readLines("2021/05-input")) %>%
  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)

# Trick from https://twitter.com/skyetetra
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)

# Trick from https://twitter.com/skyetetra
min(
  sum(adjust(abs(floor(mean(input)) - input))),
  sum(adjust(abs(ceiling(mean(input)) - input)))
)

0.067 sec elapsed

Day 8

Part 1

library(tidyverse)

readLines("2021/08-input") %>%
  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)

input <- readLines("2021/08-input")

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)

input <- readLines("2021/09-input") |>
  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)

input <- readLines("2021/09-input") |>
  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)

input <- readLines("2021/10-input")

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)

input <- readLines("2021/10-input")

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)]

add_next_step <- function(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 %>%
    map(add_next_step) %>%
    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)
)

adjacency <- split(input$from, input$to)

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
  for (i in adjacency[[current]]) {
    out <- out + paths(i, seen, duplicate)
  }
  out
}

paths(current = "start", seen = NULL, duplicate = NULL)

6.642 sec elapsed

Day 13

library(tidyverse)

input <- readLines("2021/13-input")

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)

input <- readLines("2021/13-input")

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)

template <- readLines("2021/14-input")[1]
pairs <- readLines("2021/14-input")[-(1:2)]

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))))
names(adj) <- from

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)) {
    new_counts[adj[[pair]][1]] <- new_counts[adj[[pair]][1]] + counts[pair]
    new_counts[adj[[pair]][2]] <- new_counts[adj[[pair]][2]] + counts[pair]
  }
  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)

template <- readLines("2021/14-input")[1]
pairs <- readLines("2021/14-input")[-(1:2)]

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))))
names(adj) <- from

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)) {
    new_counts[adj[[pair]][1]] <- new_counts[adj[[pair]][1]] + counts[pair]
    new_counts[adj[[pair]][2]] <- new_counts[adj[[pair]][2]] + counts[pair]
  }
  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

Day 15

Day 16

Day 17

Day 18

Day 19

Day 20

Day 21

Day 22

Day 23

Day 24

Day 25