My 2023 Solutions

Day 1

Part 1

input <- readLines("2023/01-input")

input |>
  stringr::str_extract_all("\\d") |>
  purrr::map_chr(~ paste0(head(.x, 1), tail(.x, 1))) |>
  as.integer() |>
  sum()
0.01 sec elapsed

Part 2

input <- readLines("2023/01-input")

numbers <- c(
  "one" = 1, "two" = 2, "three" = 3, "four" = 4, "five" = 5,
  "six" = 6, "seven" = 7, "eight" = 8, "nine" = 9,
  setNames(nm = 1:9)
)
srebmun <- numbers
names(srebmun) <- stringi::stri_reverse(names(srebmun))

get_digit <- function(x, ref) {
  res <- x |>
    stringr::str_extract(paste0("(", paste0(names(ref), collapse = "|"), ")"))

  ref[res]
}

sum(
  get_digit(input, numbers) * 10 +
  get_digit(stringi::stri_reverse(input), srebmun)
)
0.006 sec elapsed

Day 2

Part 1

input <- readLines("2023/02-input")

blue <- function(x) {
  x |>
    stringr::str_extract("\\d+ blue") |>
    stringr::str_extract("\\d++") |>
    as.numeric()
}
green <- function(x) {
  x |>
    stringr::str_extract("\\d+ green") |>
    stringr::str_extract("\\d++") |>
    as.numeric()
}
red <- function(x) {
  x |>
    stringr::str_extract("\\d+ red") |>
    stringr::str_extract("\\d++") |>
    as.numeric()
}

counts <- function(x) {
  tibble::tibble(blue = blue(x), green = green(x), red = red(x))
}

library(tidyverse)

input |>
  stringr::str_remove("Game \\d+: ") |>
  stringr::str_split("; ") |>
  setNames(seq_along(input)) |>
  purrr::map(counts) |>
  purrr::list_rbind(names_to = "id") |>
  summarize(
    .by = id,
    across(everything(), max, na.rm = TRUE)
  ) |>
  filter(red <= 12, green <= 13, blue <= 14) |>
  summarise(sum(as.numeric(id)))
0.385 sec elapsed

Part 2

input <- readLines("2023/02-input")

blue <- function(x) {
  x |>
    stringr::str_extract("\\d+ blue") |>
    stringr::str_extract("\\d++") |>
    as.numeric()
}
green <- function(x) {
  x |>
    stringr::str_extract("\\d+ green") |>
    stringr::str_extract("\\d++") |>
    as.numeric()
}
red <- function(x) {
  x |>
    stringr::str_extract("\\d+ red") |>
    stringr::str_extract("\\d++") |>
    as.numeric()
}

counts <- function(x) {
  tibble::tibble(blue = blue(x), green = green(x), red = red(x))
}

library(tidyverse)

input |>
  stringr::str_remove("Game \\d+: ") |>
  stringr::str_split("; ") |>
  setNames(seq_along(input)) |>
  purrr::map(counts) |>
  purrr::list_rbind(names_to = "id") |>
  summarize(
    .by = id,
    across(everything(), max, na.rm = TRUE)
  ) |>
  mutate(power = blue * green * red) |>
  summarize(sum(power))
0.223 sec elapsed

Day 3

Part 1

read_matrix <- function(path, sep = "", fill = NA, type = identity) {
  lines <- readLines(path)
  tokens <- strsplit(lines, sep)
  token_lengths <- lengths(tokens)
  res <- matrix(fill, nrow = length(lines), ncol = max(token_lengths))

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

mat <- read_matrix("2023/03-input")

partnumber <- matrix(FALSE, nrow = nrow(mat), ncol = ncol(mat))

numbers <- as.character(0:9)

invalids <- c(numbers, ".")

around <- function(x, y, x_max = nrow(mat), y_max = ncol(mat)) {
  xs <- x + c(-1, 0, 1)
  ys <- y + c(-1, 0, 1)

  xs <- xs[xs > 0]
  ys <- ys[ys > 0]
  xs <- xs[xs <= x_max]
  ys <- ys[ys <= y_max]


  mat[xs, ys]
}

for (i in seq_len(nrow(mat))) {
  for (j in seq_len(ncol(mat))) {
    partnumber[i, j] <- ifelse(
      mat[i, j] %in% numbers,
      any(!around(i, j) %in% invalids),
      FALSE
    )
  }
}

gears <- reshape2::melt(mat == "*") |>
  dplyr::filter(value)

input <- readLines("2023/03-input")

number_locs <- input |>
  stringr::str_locate_all("\\d+")

partnumbers <- c()

for (i in seq_along(input)) {
  rows <- number_locs[[i]]
  for (row in seq_len(nrow(rows))) {
    start <- rows[row, 1]
    end <- rows[row, 2]
    if (any(partnumber[i, seq(start, end)])) {
      partnumbers <- c(partnumbers, stringr::str_sub(input[i], start, end))
    }
  }
}

partnumbers |>
  as.numeric() |>
  sum()
0.075 sec elapsed

Part 2

read_matrix <- function(path, sep = "", fill = NA, type = identity) {
  lines <- readLines(path)
  tokens <- strsplit(lines, sep)
  token_lengths <- lengths(tokens)
  res <- matrix(fill, nrow = length(lines), ncol = max(token_lengths))

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

mat <- read_matrix("2023/03-input")

partnumber <- matrix(FALSE, nrow = nrow(mat), ncol = ncol(mat))

numbers <- as.character(0:9)

invalids <- c(numbers, ".")

around <- function(x, y, x_max = nrow(mat), y_max = ncol(mat), MAT = mat) {
  xs <- x + c(-1, 0, 1)
  ys <- y + c(-1, 0, 1)

  xs <- xs[xs > 0]
  ys <- ys[ys > 0]
  xs <- xs[xs <= x_max]
  ys <- ys[ys <= y_max]


  MAT[xs, ys]
}

for (i in seq_len(nrow(mat))) {
  for (j in seq_len(ncol(mat))) {
    partnumber[i, j] <- ifelse(
      mat[i, j] %in% numbers,
      any(!around(i, j) %in% invalids),
      FALSE
    )
  }
}

gears <- reshape2::melt(mat == "*") |>
  dplyr::filter(value)

input <- readLines("2023/03-input")

number_locs <- input |>
  stringr::str_locate_all("\\d+")

partnumber_id <- matrix(nrow = nrow(mat), ncol = ncol(mat))

id <- 0
part_numbers_id <- c()
for (i in seq_along(input)) {
  rows <- number_locs[[i]]
  for (row in seq_len(nrow(rows))) {
    start <- rows[row, 1]
    end <- rows[row, 2]
    if (any(partnumber[i, seq(start, end)])) {
      id <- id + 1
      partnumber_id[i, seq(start, end)] <- id
      part_numbers_id <- c(
        part_numbers_id,
        paste0(mat[i, seq(start, end)], collapse = "")
      )
    }
  }
}

part_numbers_id <- as.numeric(part_numbers_id)

sums <- 0
for (i in seq_len(nrow(gears))) {
  res <- around(gears[i, ]$Var1, gears[i, ]$Var2, MAT = partnumber_id)
  neighbors <- unique(res[!is.na(res)])
  if (length(neighbors) == 2) {
    sums <- sums + prod(part_numbers_id[neighbors])
  }
}

sums
0.131 sec elapsed

Day 4

Part 1

input <- readLines("2023/04-input")

input

winning <- input |>
  stringr::str_extract("\\:.*\\|") |>
  stringr::str_extract_all("\\d+") |>
  lapply(as.integer)

numbers <- input |>
  stringr::str_extract("\\|.*") |>
  stringr::str_extract_all("\\d+") |>
  lapply(as.integer)

score <- function(x) {
  if (x == 0) {
    return(0)
  }

  2 ^ (x - 1)
}

purrr::map2_int(winning, numbers, ~ score(sum(.x %in% .y))) |>
  sum()
0.007 sec elapsed

Part 2

input <- readLines("2023/04-input")

input

winning <- input |>
  stringr::str_extract("\\:.*\\|") |>
  stringr::str_extract_all("\\d+") |>
  lapply(as.integer)

numbers <- input |>
  stringr::str_extract("\\|.*") |>
  stringr::str_extract_all("\\d+") |>
  lapply(as.integer)

cards <- rep(1, length(input))

for (i in seq_along(cards)) {
  if (i == 0) next
  n <- cards[i]

  wins <- sum(winning[[i]] %in% numbers[[i]])

  cards[seq_len(wins) + i] <- cards[seq_len(wins) + i] + n
}

sum(cards)
0.007 sec elapsed

Day 5

Day 6

Day 7

Day 8

Day 9

Day 10

Day 11

Day 12

Day 13

Day 14

Day 15

Day 16

Day 17

Day 18

Day 19

Day 20

Day 21

Day 22

Day 23

Day 24

Day 25