Advent of Code 2022

adventofcode.com

Introduction

This analysis is my attempt at adventofcode.com using R and Quarto.

Answers will be for the sample data.

Here’s an overview from adventofcode.com.

Santa’s reindeer typically eat regular reindeer food, but they need a lot of magical energy to deliver presents on Christmas. For that, their favorite snack is a special type of star fruit that only grows deep in the jungle. The Elves have brought you on their annual expedition to the grove where the fruit grows.

To supply enough magical energy, the expedition needs to retrieve a minimum of fifty stars by December 25th. Although the Elves assure you that the grove has plenty of fruit, you decide to grab any fruit you see along the way, just in case.

Collect stars by solving puzzles. Two puzzles will be made available on each day in the Advent calendar; the second puzzle is unlocked when you complete the first. Each puzzle grants one star. Good luck!

Code

library(tidyverse)
library(scales)
library(here)
library(gfonts)
library(patchwork)
library(jsonlite)
library(tidygraph)
library(ggraph)

options(
  dplyr.width = Inf,
  papersize = "a4",
  tab.width = 2,
  width = 80,
  max.print = 25,
  stringsAsFactors = FALSE,
  lubridate.week.start = 6,
  tibble.print_max = 25,
  tibble.print_min = 25,
  tibble.width = Inf,
  dplyr.summarise.inform = FALSE,
  tidyverse.quiet = TRUE
)

source('branding/aoc-theme.r')

stars <- 0

Day 1 * *

Calorie Counting

Code

df1 <- tibble(cals = readLines('inputs/day1.txt')) |>
  mutate(
    cals = as.numeric(cals),
    row = row_number(),
    elf = case_when(
      row == 1 ~ row,
      is.na(cals) ~ row
    )
  ) |>
  fill(elf) |>
  filter(!is.na(cals)) |>
  group_by(elf) |>
  summarise(cals = sum(cals)) |>
  ungroup() |>
  arrange(-cals)

stars <- stars + 1

The maximum calories carried by an elf is 24,000. *

Code

top_3_cals <- df1 |>
  head(3) |>
  summarise(cals = sum(cals)) |>
  pull(cals)

stars <- stars + 1

The calories carried by the top three elves is 45,000. *

Day 2 * *

Rock Paper Scissors

Code

df2 <- tibble(strat = readLines('inputs/day2.txt')) |>
  separate(strat, into = c('them', 'us')) |>
  mutate(
    shape = case_when(
      us == 'X' ~ 1,
      us == 'Y' ~ 2,
      us == 'Z' ~ 3
    ),
    outcome = case_when(
      them == 'A' & us == 'X' ~ 3,
      them == 'A' & us == 'Y' ~ 6,
      them == 'A' & us == 'Z' ~ 0,
      them == 'B' & us == 'X' ~ 0,
      them == 'B' & us == 'Y' ~ 3,
      them == 'B' & us == 'Z' ~ 6,
      them == 'C' & us == 'X' ~ 6,
      them == 'C' & us == 'Y' ~ 0,
      them == 'C' & us == 'Z' ~ 3
    ),
    score = shape + outcome
  ) 

stars <- stars + 1

The total points for this strategy are 15. *

Code

df2_p2 <- df2 |>
  mutate(
    outcome = us,
    us = case_when(
      them == 'A' & outcome == 'X' ~ 'Z',
      them == 'A' & outcome == 'Y' ~ 'X',
      them == 'A' & outcome == 'Z' ~ 'Y',
      them == 'B' & outcome == 'X' ~ 'X',
      them == 'B' & outcome == 'Y' ~ 'Y',
      them == 'B' & outcome == 'Z' ~ 'Z',
      them == 'C' & outcome == 'X' ~ 'Y',
      them == 'C' & outcome == 'Y' ~ 'Z',
      them == 'C' & outcome == 'Z' ~ 'X'
    ),
    shape_points = case_when(
      us == 'X' ~ 1,
      us == 'Y' ~ 2,
      us == 'Z' ~ 3
    ),
    outcome_points = case_when(
      outcome =='X' ~ 0,
      outcome =='Y' ~ 3,
      outcome =='Z' ~ 6
    ),
    score = shape_points + outcome_points
  ) 

stars <- stars + 1

The total points for the updated strategy are 12. *

Day 3 * *

Rucksack Reorganization

Code

scoring3 <- tibble(
  contents_item = c(letters, LETTERS),
  priority = 1:52
)

df3 <- tibble(contents = readLines('inputs/day3.txt')) |>
  mutate(
    rucksack = row_number(),
    len = str_length(contents),
    contents_item = str_split(contents, "")
  ) |>
  unnest(contents_item) |>
  group_by(rucksack) |>
  mutate(
    compartment = if_else(row_number() <= len / 2, 'a', 'b')
  ) 
  
df3_1 <- df3|>
  distinct(rucksack, contents_item, compartment) |>
  group_by(rucksack, contents_item) |>
  filter(n() > 1) |>
  ungroup() |>
  distinct(rucksack, contents_item) |>
  left_join(scoring3, by = 'contents_item')

stars <- stars + 1

The total priority for the rucksacks is 157. *

Code

df3_2 <- df3 |>
  mutate(
    trio = (rucksack - 1) %/% 3
  ) |>
  distinct(rucksack, contents_item, trio) |>
  group_by(trio, contents_item) |>
  filter(n()  == 3) |>
  ungroup() |>
  distinct(contents_item, trio) |>
  left_join(scoring3, by = 'contents_item') 

stars <- stars + 1

The total priority for the badges is 70. *

Day 4 * *

Camp Cleanup

Code

df4 <- tibble(sections = readLines('inputs/day4.txt')) |> 
  separate(sections, into = c('elf1_min', 'elf1_max', 'elf2_min', 'elf2_max'), convert = TRUE) |> 
  mutate(pair = row_number())

df4_1 <- df4 |> 
  filter(
    (elf1_min <= elf2_min & elf1_max >= elf2_max) |
    (elf2_min <= elf1_min & elf2_max >= elf1_max) 
  ) 

stars <- stars + 1

The assignment pairs where one fully contains the other is 2. *

Code

df4_2 <- df4 |> 
  filter(
    (elf1_max >= elf2_min & elf1_max <= elf2_max) |
    (elf2_max >= elf1_min & elf2_max <= elf1_max)  
  )

stars <- stars + 1

The assignment pairs where they overlap is 4. *

Day 5 * *

Supply Stacks

Code

df5 <- readLines('inputs/day5.txt')

movements <- tibble(crates = df5) |> 
  filter(cumsum(str_trim(crates) == '') > 0 & str_trim(crates) != '') |> 
  separate(crates, into = c('move', 'move_num', 'from', 'stack_from', 'to', 'stack_to'), sep = ' ', convert = TRUE) |> 
  select(-move, -from, -to) 

stack <- df5[cumsum(str_trim(df5) == '') == 0]

stack_nums <- (str_length(tail(stack, 1)) + 1) %/% 4
stack_seq <- seq(2, stack_nums * 4, by = 4)

stack_list <- map(stack_seq, ~rev(str_sub(stack, .x, .x)))
#names(stack_list) = paste0('stack_', 1:stack_nums)
adj_stack <- map(stack_list, ~ .x[str_trim(.x) != ''])

move <- function(stack_from, stack_to) {
  start_stack <- adj_stack[[stack_from]]
  end_stack <- adj_stack[[stack_to]]
  
  to_move <- tail(start_stack, 1)
  
  adj_stack[[stack_to]] <<- c(end_stack, to_move)
  adj_stack[[stack_from]] <<- start_stack[1:length(start_stack)-1]
}

move_times <- function(move_num, stack_from, stack_to) {
  for(i in 1:move_num) {move(stack_from, stack_to)}
}


pwalk(movements, move_times)


final_stack <- adj_stack

message <- paste(map(final_stack, ~tail(.x, 1)), collapse = '')

stars <- stars + 1

The crates on the top of each stack are CMZ. *

Code

adj_stack <- map(stack_list, ~ .x[str_trim(.x) != ''])

move2 <- function(move_num, stack_from, stack_to) {
  start_stack <- adj_stack[[stack_from]]
  end_stack <- adj_stack[[stack_to]]
  
  to_move <- tail(start_stack, move_num)
  
  adj_stack[[stack_to]] <<- c(end_stack, to_move)
  
  adj_stack[[stack_from]] <<- start_stack[1:(length(start_stack)-move_num)] 
}

pwalk(movements, move2)

final_stack <- adj_stack

message2 <- paste(map(final_stack, ~tail(.x, 1)), collapse = '')


stars <- stars + 1

With the new crane the crates on the top of each stack are MCD. *

Day 6 * *

Tuning Trouble

Code

raw_6 <- readLines('inputs/day6.txt')

df_6 <- tibble(chars = str_split(raw_6, pattern = '')) |>  
  unnest(chars) |> 
  mutate(
    row = row_number(),
    marker = if_else(
      row <= 3,
      FALSE,
     chars != lag(chars, 3) & chars != lag(chars, 2) & chars != lag(chars, 1) &
     lag(chars, 1) != lag(chars, 3) & lag(chars, 1) != lag(chars, 2) & 
     lag(chars, 2) != lag(chars, 3)
    )
  )

sop <- df_6 |> 
  filter(marker == TRUE) |> 
  slice(1) |> 
  pull(row)

stars <- stars + 1

The start of packet marker is at 6. *

Code

chars <- unlist(str_split(raw_6, pattern = ''))

mapover <- 0:13
names(mapover) <- paste0('c',mapover)

som <- map_dfc(mapover, ~lag(chars, .x)) |> 
  mutate(row = row_number()) |> 
  filter(row >= 14) |> 
  gather(-row, key = 'lag',value = 'value') |> 
  group_by(row) |> 
  summarise(
    n_distinct = n_distinct(value)
  ) |> 
  filter(n_distinct == 14) |> 
  slice(1) |> 
  pull(row)

stars <- stars + 1

The start of message marker is at 23. *

Day 7 * *

No Space Left On Device

Code

pth <- function(path, cd) {
  if (!is.na(cd)) {
    if (cd == "..") {
      return(head(path, -1))
    }
    return(c(path, paste0(tail(path, 1), "/", cd)))
  }
  return(path)
}

df_7 <- tibble(instruct = readLines('inputs/day7.txt')) |> 
  mutate(
    row = row_number(),
    command = case_when(
      str_sub(instruct, 1, 1) == '$' ~ str_sub(instruct, 3)
    ),
    #file = case_when(
    #  is.na(command) ~ str_split(instruct, pattern = ' ', n = 2, simplify = TRUE)
    #),
    file_size = as.numeric(str_extract(instruct, '([:alnum:]+)\\b')),
    file_name = if_else(
      !is.na(file_size),
      str_extract(instruct, '(\\b[:alnum:]+\\.[:alnum:]+)$'),
      str_extract(instruct, '(\\b[:alnum:]+)$')
    ),
    type = case_when(
      !is.na(command) ~ 'command',
      !is.na(file_size) ~ 'file',
      TRUE ~ 'folder'
    ),
    cd = case_when(str_sub(command, 1, 2) == 'cd' ~ str_sub(command, 4))
  ) |> 
  select(row, cd, file_size) |> 
  mutate(
    path = accumulate(cd, pth)
  ) |> 
  unnest(path) |> 
  filter(!is.na(file_size)) |> 
  group_by(path) |> 
  summarise(
    file_size = sum(file_size)
  ) |> 
  ungroup()

tot_u100k <- df_7 |> 
  filter(file_size < 100000)  |> 
  summarise(sum(file_size)) |> 
  pull()


stars <- stars + 1

The total directory size is 95,437. *

Code

tot_space <- 70000000
unused_space <- tot_space - max(df_7$file_size)
unused_required <- 30000000
to_delete <- unused_required - unused_space

dir_size <- df_7 |> 
  arrange(file_size) |> 
  filter(file_size >= to_delete) |> 
  head(1) |> 
  pull(file_size)

stars <- stars + 1

The best folder to delete has a size of 24,933,642. *

Day 8 * *

Treetop Tree House

Code

raw_8 <- readLines('inputs/day8.txt')

visible <- tibble(trees = raw_8) |> 
  mutate(
    tree = str_split(trees, ""),
    row = row_number()
    ) |> 
  group_by(row) |> 
  unnest(tree) |> 
  #filter(row == 1) |> 
  mutate(
    tree = as.numeric(tree),
    column = row_number(),
    row_down = cummax(tree),
    visible = if_else(
      row_number() == 1,
      TRUE,
      tree > lag(row_down)
    ),
    row_up = order_by(-column, cummax(tree)),
    visible = if_else(
      visible | row_number() == n(),
      TRUE,
      tree > lead(row_up)
    )
  ) |> 
  group_by(column) |> 
  mutate(
    row_right = cummax(tree),
    visible = if_else(
      visible | row_number() == 1,
      TRUE,
      tree > lag(row_right)
    ),
    row_left = order_by(-row, cummax(tree)),
    visible = if_else(
      visible | row_number() == n(),
      TRUE,
      tree > lead(row_left)
    ),
  ) |> 
  ungroup()


visible |> 
  ggplot(aes(column, -row, fill =  tree, label = tree)) + 
  geom_tile() +
  #geom_text(colour = aoc_black) +
  scale_fill_gradient(high = aoc_dgreen, low = aoc_yellow) +
  #coord_fixed() +
  theme_aoc_null() +
  labs(
    title = 'Tree heights'
  ) +
  guides(fill = 'none')

Code

stars <- stars + 1

The total number of visible trees is 21. *

Code

visible |> 
  ggplot(aes(column, -row, fill = visible, label = tree)) + 
  geom_tile() +
  #geom_text(colour = aoc_black) +
  scale_fill_manual(values = c('FALSE' = aoc_yellow, 'TRUE' = aoc_dgreen)) +
  #coord_fixed() +
  theme_aoc_null() +
  labs(
    title = 'Visible trees'
  ) +
  guides(fill = 'none')

Code

# function for each direction ---------------------------------------------


look_count <- function(df) {

df |> 
  filter(row_number() != 1) |> 
  mutate(
    cummax_tree = pmax(z, cummax(tree)),
    taller = tree >= cummax_tree,
    after_taller = coalesce(lag(cummax(taller)), 0)
  ) |> 
    
  filter(! after_taller)  |> 
  nrow()
  
}  

# function to repeat ------------------------------------------------------

look_directions <- function(x, y) {

left <-  visible |> 
  select(tree, row, column) |> 
  mutate( z = sum((row == y & column == x) * tree)) |> 
  filter(row == y) |> 
  filter(column <= x) |> 
  arrange(-column) |> 
  look_count()

right <-  visible |> 
  select(tree, row, column) |> 
  mutate( z = sum((row == y & column == x) * tree)) |> 
  filter(row == y) |> 
  filter(column >= x) |> 
  look_count() 

up <- visible |> 
  select(tree, row, column) |> 
  mutate( z = sum((row == y & column == x) * tree)) |> 
  filter(column == x) |> 
  filter(row <= y) |> 
  arrange(-row) |> 
  look_count()

down <- visible |> 
  select(tree, row, column) |> 
  mutate( z = sum((row == y & column == x) * tree)) |> 
  filter(column == x) |> 
  filter(row >= y) |> 
  look_count() 

scenic_score <- left * right * up * down

}

# run for each tree -------------------------------------------------------

scenic <- visible |> 
  select(tree, row, column) |> 
  mutate(
    scenic_score = map2(column, row, look_directions)
  ) |> 
  unnest_longer(scenic_score) 


# get maximum -------------------------------------------------------------

max_scenic <- scenic |> 
  filter(scenic_score == max(scenic_score)) |> 
  slice(1) |> 
  pull(scenic_score)

# plot scenic scores ------------------------------------------------------

scenic |> 
  ggplot(aes(column, -row, fill = scenic_score, label = tree)) + 
  geom_tile() +
  scale_fill_continuous(low = aoc_yellow, high = aoc_dgreen) +
  theme_aoc_null() +
  labs(
    title = 'Scenic score of trees'
  ) +
  guides(fill = 'none')

Code

# increment stars ---------------------------------------------------------

stars <- stars + 1

The highest scenic score for a tree is 8. *

Day 9 * *

Rope Bridge

Code

df_9 <- tibble(lines = readLines('inputs/day9.txt')) |> 
  separate(lines, into = c('direction', 'moves'), convert = TRUE) |> 
  uncount(moves) |> 
  mutate(
    row = row_number(),
    x = case_when(
      direction == 'R' ~ -1,
      direction == 'L' ~ 1,
      TRUE ~ 0
    ),
    y = case_when(
      direction == 'D' ~ -1,
      direction == 'U' ~ 1,
      TRUE ~ 0
    )
  ) |> 
  add_row(
    row = 0, x = 0, y = 0, .before = TRUE
  ) |> 
  mutate(
    heads_x = coalesce(cumsum(x), 0),
    heads_y = coalesce(cumsum(y))
  )

follow <- function(tail, head) {
  if(max(abs(head - tail)) <= 1) {return(tail)}
  map2_dbl(tail, head, ~ .x + sign(.y - .x))
}

df_9a <- df_9 |> 
  mutate(
    head = map2(heads_x, heads_y,  c)
  ) |> 
  mutate(
    tailxy = accumulate(head, follow, .init = c(0, 0))[-1]
  )  |> 
  group_by(row) |> 
  mutate(
    tails_x = pluck(unlist(tailxy), 1),
    tails_y = pluck(unlist(tailxy), 2)
  ) |> 
  ungroup()

visited <- df_9a |> 
  distinct(tails_x, tails_y) |> 
  nrow()

stars <- stars + 1

bind_rows(
  df_9a |>
    transmute(
      type = 'Heads', row, x = heads_x, y = heads_y
    ),
  df_9a |>
    transmute(
      type = 'Tails', row, x = tails_x, y = tails_y
    )
) |> 
  ggplot(aes(-x, y, colour = type)) +
  geom_path() +
  scale_colour_manual(values = c('Heads' = aoc_white, 'Tails' = aoc_green)) +
  theme_aoc_null() +
  labs(
    colour = NULL,
    title = 'Heads and tails paths'
  )

The number of positions visited is 88. *

Code

df_9b <- df_9 |> 
  mutate(
    head = map2(heads_x, heads_y,  c)
  ) |> 
  mutate(
    tail1 = accumulate(head, follow, .init = c(0, 0))[-1],
    tail2 = accumulate(tail1, follow, .init = c(0, 0))[-1],
    tail3 = accumulate(tail2, follow, .init = c(0, 0))[-1],
    tail4 = accumulate(tail3, follow, .init = c(0, 0))[-1],
    tail5 = accumulate(tail4, follow, .init = c(0, 0))[-1],
    tail6 = accumulate(tail5, follow, .init = c(0, 0))[-1],
    tail7 = accumulate(tail6, follow, .init = c(0, 0))[-1],
    tail8 = accumulate(tail7, follow, .init = c(0, 0))[-1],
    tail9 = accumulate(tail8, follow, .init = c(0, 0))[-1]
  )  |> 
  group_by(row) |> 
  mutate(
    tails_x = pluck(unlist(tail9), 1),
    tails_y = pluck(unlist(tail9), 2)
  ) |> 
  ungroup()

visited_b <- df_9b |> 
  distinct(tails_x, tails_y) |> 
  nrow()


stars <- stars + 1

The number of positions visited by the ninth knot is 36. *

Day 10 *

Cathode-Ray Tube

Code

df_10 <- tibble(lines = readLines('inputs/day10.txt')) |> 
  separate(lines, sep = ' ', into = c('instruction', 'moves'), convert = TRUE) |> 
  mutate(row = row_number()) |> 
  mutate(
    count = if_else(instruction == 'noop', 1, 2)
  ) |> 
  uncount(count) |> 
  add_row(moves = 0) |> 
  mutate(
    cycle = row_number(),
    a_moves = coalesce(row == lag(row) | is.na(row), FALSE) * coalesce(moves, 0),
    x = head(accumulate(a_moves, `+`, .init = 1), -1),
    signal_strength = cycle * x
  )

combined_ss <- df_10 |> 
  slice(20, 60, 100, 140, 180, 220) |> 
  summarise(signal_strength = sum(signal_strength)) |> 
  pull()

stars <- stars + 1

The combined signal strength is 13,140. *

Part 2 in progress

Day 11

Monkey in the Middle

In progress

Code

df_11 <- tibble(lines = readLines('inputs/day11.txt')) |> 
  filter(lines != '') |> 
  mutate(
    row = row_number(),
    from_monkey = case_when(
      str_sub(lines, 1, 2) == 'Mo' ~ parse_number(lines)
    ),
    worry_start = case_when(
      str_sub(lines, 3, 4) == 'St' ~ str_sub(lines, 19) |> 
        str_split(pattern = ', ')
    ),
    operation = case_when(
      str_sub(lines, 3, 4) == 'Op' ~ str_sub(lines, 20)
    ),
    test_divide = case_when(
      str_sub(lines, 3, 4) == 'Te' ~ parse_number(lines)
    ),
    true_monkey = case_when(
      str_sub(lines, 8, 8) == 't' ~ parse_number(lines)
    ),
    false_monkey = case_when(
      str_sub(lines, 8, 8) == 'f' ~ parse_number(lines)
    ),
    turn = from_monkey + 1  
  ) |> 
  fill(turn) |> 
  group_by(turn) |> 
  fill( from_monkey, worry_start, operation, test_divide, true_monkey, false_monkey) |> 
  filter(row == max(row)) |> 
  ungroup() |> 
  select(-lines, -row)

# need a function to to the following steps for each item in a turn
# and then add the items to the lists for the to_monkeys

x <- df_11 |>  
  unnest(worry_start) |> 
  mutate(
    item = row_number()
  )  |> 
  group_by(row = row_number()) |> 
  mutate(
    worry_inspect = eval(parse(text = str_replace_all(operation, 'old', worry_start))),
    worry_relief = worry_inspect %/% 3,
    test = worry_relief %% test_divide == 0,
    monkey_to = if_else(test, true_monkey, false_monkey)
  ) |> 
  ungroup()

Day 12

Hill Climbing Algorithm

In progress

Code

lookup <- tibble(
  height = 1:26,
  letter = letters
)

height <- letters
names(height) <- 1:26

df_12 <- tibble(lines = readLines('inputs/day12.csv')) |> 
  mutate(
    letter = str_split(lines, ''),
    row = row_number()
  ) |> 
  unnest_longer(letter) |> 
  left_join(lookup, by = 'letter') |> 
  group_by(row) |> 
  mutate(
    column = row_number(),
    height = case_when(
      letter == 'S' ~ 0L,
      letter == 'E' ~ 27L,
      TRUE ~ height
    )
  ) |> 
  ungroup() |> 
  select(-lines) 


df_12 |> 
  ggplot(aes(x= column, y = -row, fill = height, label = letter)) +
  geom_tile(colour = aoc_black) +
  #geom_text(colour = aoc_white) +
  scale_fill_continuous(low = aoc_yellow, high = aoc_dgreen) +
  labs(
    x = NULL, y = NULL, fill = NULL,
    title = 'Terrain height'
  ) +
  theme_aoc_null() +
  guides(fill = 'none')

Day 13

Distress Signal

In progress

Code

df_13 <- tibble(lines = readLines('inputs/day13.csv')) |> 
  mutate(
    pair = case_when(row_number() == 1 | lines == '' ~ cumsum(lines == '') + 1)
  ) |> 
  fill(pair) |> 
  filter(lines != '') |> 
  group_by(row = row_number()) |> 
  mutate(
    lists = map(lines, parse_json)
  ) |> 
  select(-lines) |> 
  group_by(pair) |> 
  mutate(row = paste0('list_', row_number())) |> 
  spread(key = row, value = lists) |> 
  ungroup()

Day 14

Regolith Reservoir

In progress

Code

df_14 <- tibble(lines = readLines('inputs/day14.txt')) |> 
  mutate(
    row = row_number(),
    step = str_split(lines, ' -> ')
  ) |> 
  group_by(row) |> 
  unnest_longer(step) |> 
  mutate(
    step_no = row_number()
  ) |> 
  separate(step, into = c('x', 'y'), sep = ',', convert = TRUE) |> 
  mutate(
    x_lag = coalesce(lag(x), x),
    y_lag = coalesce(lag(y), y),
    x = map2(x, x_lag, seq),
    y = map2(y, y_lag, seq)
  ) |> 
  ungroup() |> 
  unnest_longer(c(x, y)) |> 
  distinct(row, x, y)

full_cave <- crossing(
  x = seq(min(df_14$x) - 2, max(df_14$x) + 2),
  y = seq(0, max(df_14$y) + 1)
) |> 
  left_join(
    df_14 |>  
      mutate(pocket = 1), 
  by = c('x', 'y')
  ) |> 
  mutate(
    pocket = case_when(
      ! is.na(pocket) ~ pocket,
      x == max(x) ~ 1,
      x == min(x) ~ 1,
      TRUE ~ 0
    ),
    pocket_colour = if_else(pocket == 1, aoc_white, aoc_dgrey)
  )


full_cave |> 
  ggplot(aes(x, -y, colour = I(pocket_colour))) +
  geom_point() +
  annotate('point', x = 500, y = 0, colour = aoc_yellow, shape = 18) +
  scale_y_continuous(label = abs, limits = c(NA, 0), breaks = 0:min(-df_14$y)) +
  scale_x_continuous(position = 'top', breaks = 0:max(df_14$x)) +
  scale_colour_identity() +
  labs(
    x = NULL, y = NULL,
    title = 'Rocks'
  ) +
  theme(
    panel.grid.major.x = element_blank(),
    panel.grid.major.y = element_blank()
  ) +
  guides(x = 'none', y = 'none', colour = 'none')

Day 15

In progress

Beacon Exclusion Zone

Code

df_15 <- tibble(lines = readLines('inputs/day15.txt')) |> 
  separate(lines, sep = ':', into = c('sensor', 'beacon')) |> 
  separate(sensor, sep = ',', into = c('sensor_x', 'sensor_y')) |> 
  separate(beacon, sep = ',', into = c('beacon_x', 'beacon_y')) |> 
  mutate_all(parse_number) |> 
  mutate(
    pair = row_number(),
    manhattan = abs(sensor_x - beacon_x) + abs(sensor_y - beacon_y)
  )

df_15 |> 
  #filter(sensor_x == 8 & sensor_y == 7) |> 
  ggplot(aes(group = pair)) +
  geom_segment(
    aes(x = sensor_x, y = sensor_y, xend = beacon_x, yend = beacon_y),
    colour = aoc_white
  ) +
  geom_point(aes(x = sensor_x, y = sensor_y), colour = aoc_yellow, size = 5) +
  geom_point(aes(x = beacon_x, y = beacon_y), colour = aoc_green, shape = 18, size = 5) +
  scale_x_continuous(position = 'top') +
  scale_y_reverse() +
  labs(
    x = NULL, y = NULL,
    title = 'Closest beacon to sensor'
  ) +
  theme(
    panel.grid.major.x = element_blank(),
    panel.grid.major.y = element_blank()
  ) +
  guides(x = 'none', y = 'none')

Was working on test data but vectors were too big for actual data. Rewriting underway but still seems too big to run properly.

Day 16

Proboscidea Volcanium

In progress

Looks like this is a network.

Code

df_16 <- tibble(lines = readLines('inputs/day16.txt')) |> 
  separate(lines, sep = ';', into = c('valves', 'tunnel')) |> 
  mutate(
    valves = str_remove(valves, 'Valve\\s') |> 
      str_remove('has flow rate='),
    to_valves = str_remove(tunnel, '\\stunnels?\\sleads?\\sto\\svalves?\\s') |> 
      str_split(pattern = ', '),
    valve_on = FALSE
  ) |> 
  select(-tunnel) |> 
  separate(valves, sep = ' ', into = c('valve', 'flow'), convert = TRUE)


df_16_nodes <- select(df_16, name = valve  )

df_16_edges <- df_16 |> 
  select(from = valve  , to_valves ) |> 
  unnest_longer(to_valves )


df_16_graph <- tbl_graph(nodes = df_16_nodes, edges = df_16_edges) |> 
  activate(nodes) |> 
  mutate(
    node_on = FALSE,
    flow = df_16$flow,
    open_time = 1,
    start_node = name == 'AA'
  ) |> 
  activate(edges) |> 
  mutate(
    tunnel_time = 1
  )    

ggraph(df_16_graph) +
  geom_edge_link(colour = aoc_white) +
  geom_node_point(size = 5, aes(colour = start_node)) +
  scale_colour_manual(values = c(aoc_green, aoc_yellow)) +
  theme_aoc_null() +
  labs(
    title = 'Valve and tunnel network'
  ) +
  guides(colour = 'none')

Day 17

Pyroclastic Flow

In progress

Looks like Tetris.

Code

df_17_shapes <- tibble(lines = readLines('inputs/day17.txt'))

df_17_wind <- '>>><<><>><<<>><>>><<<>>><<<><<<>><>><<>>'

Day 18 *

Boiling Boulders

Code

df_18 <- tibble(lines = readLines('inputs/day18.txt')) |> 
  separate(lines, sep = ',', into = c('x', 'y', 'z'), convert = TRUE) 

df_18 |>
  ggplot(aes(x, y)) +
  geom_tile(fill = aoc_dgreen) +
  facet_wrap(~z) +
  labs(
    title = 'Cross section slices (Z)'
  )

Code

xy <- df_18 |> 
      inner_join(df_18, by = c('x', 'y')) |> 
      filter(abs(z.x - z.y) == 1)

xz <- df_18 |> 
  inner_join(df_18, by = c('x', 'z')) |> 
  filter(abs(y.x - y.y) == 1)

yz <- df_18 |> 
  inner_join(df_18, by = c('y', 'z')) |> 
  filter(abs(x.x - x.y) == 1)

surface <- (nrow(df_18) * 6) - nrow(xy) - nrow(xz) - nrow(yz)

stars <- stars + 1

The surface area is 64. *

Part 2 in progress

Code

inner <- crossing(
  x = (min(df_18$x) + 1):(max(df_18$x) - 1),
  y = (min(df_18$y) + 1):(max(df_18$y) - 1),
  z = (min(df_18$z) + 1):(max(df_18$z) - 1)
) |>
  anti_join(df_18, by = c('x', 'y', 'z'))

# need to check if there is a tunnel to these inner spots

Day 19

Not Enough Minerals

In progress

Code

minutes <- 24

df_19 <- tibble(lines = readLines('inputs/day19.txt')) |> 
  separate(lines, sep = ': ', into = c('blueprint', 'details')) |> 
  separate(
    details, 
    sep = '\\. ', 
    into = c('ore', 'clay', 'obsidian', 'geode')
  ) |>
  gather(-blueprint, key = 'robot', value = 'cost') |> 
  mutate(
    cost = str_sub(cost, str_length(robot) + 19) |> 
      str_remove('\\.') |> 
      str_split(' and ')
  ) |> 
  unnest_longer(cost) |> 
  separate(cost, sep = ' ', into = c('cost_num', 'cost_type'), convert = TRUE) |> 
  mutate(
    robot = factor(robot, levels = c('ore', 'clay', 'obsidian', 'geode')),
    cost_type = factor(cost_type, levels = c('ore', 'clay', 'obsidian', 'geode'))) |> 
  arrange(blueprint, robot, cost_type) |> 
  spread(key = cost_type, value = cost_num, fill = 0) 

b <- unique(df_19$blueprint)[1]

bank_type <- list(
  ore = 0,
  clay = 0,
  obsidian = 0,
  geode = 0)

bank_robot <- list(
  ore_robot = 1,
  clay_robot = 0,
  obsidian_robot = 0
)

spend_collect <- function(b) {
  
}

Day 20

Grove Positioning System

Code

df_20 <- tibble(lines = readLines('inputs/day20.txt')) |> 
  transmute(
    move = as.numeric(lines),
    orig_order = as.double(row_number()),
    current_order = as.double(orig_order)
  )

last_index <- nrow(df_20)
loop <- 1:(last_index)

zeroth <- df_20 |> 
  filter(move == 0) |> 
  pull(orig_order)


# wrap modulus function ---------------------------------------------------


mod_shift <- function(num, base) {
  ((num - 1) %% base) + 1
}


# loop function -----------------------------------------------------------


make_change <- function(l) {
  
l_move <<- df_20 |> 
  filter(orig_order == l) |> 
  pull(move)

from_position <<- after_loop |>
  filter(orig_order == l) |> 
  pull(current_order)

raw_shift <- if((from_position + l_move) > last_index) {
  from_position + l_move + 1
} else if( l_move > 0 & (from_position + l_move) > 0) {
  from_position + l_move
} else {
  from_position + l_move - 1
}

to_position <- mod_shift(raw_shift,  last_index)

after_loop <<- after_loop |>
    mutate(
      old_order = as.double(current_order),
      move_position = from_position,
      new_position = to_position,
      current_order = case_when(
        l_move == 0 ~ old_order, 
        
        old_order == move_position ~ new_position,
        
        move_position < new_position &
          move_position <= old_order &
          old_order <= new_position ~ 
          mod_shift(old_order - 1, last_index),
        
        move_position > new_position &
          new_position <= old_order &
          old_order <= move_position ~ 
          mod_shift(old_order + 1, last_index),
        
        TRUE ~ old_order
      )
    ) 
}


# prepare for loop --------------------------------------------------------

after_loop <- df_20 |> 
  group_by(orig_order)  


# run loops ---------------------------------------------------------------

walk(loop, make_change)

# get selected values -----------------------------------------------------


values_wanted <- c(0, 1000, 2000, 3000) %% last_index

resort_zero <- after_loop |> 
  ungroup() |> 
  mutate(
    zero_position = sum((orig_order == zeroth) * current_order),
    final_position = (current_order - zero_position) %% last_index
  ) 

df_20_sum <- resort_zero |> 
  filter(final_position %in% values_wanted) |> 
  summarise(final = sum(move)) |> 
  pull(final)

The grove coordinates sum to 3. *

Part 2 to do

Day 21 * *

Monkey Math

Code

df_21 <- tibble(lines = readLines('inputs/day21.txt')) |> 
  separate(lines, into = c('monkey', 'equation'), sep = ': ') |> 
  mutate(
    type = case_when(
      str_count(equation, '\\s') == 0 ~ 'Number',
      TRUE ~ 'Monkeys'
    )
  ) |> 
  arrange(type)

monkey_numbers <- df_21 |> 
  filter(type == 'Number') |> 
  transmute(monkey_name = monkey, number = parse_number(equation))

still_equation <- df_21 |> 
  filter(type == 'Monkeys') |> 
  separate(equation, sep = '\\s', into = c('monkey_1', 'equation', 'monkey_2')) |> 
  gather(
    c(monkey_1, monkey_2),
    key = order_monkey,
    value = monkey_name
  ) |> 
  arrange(monkey, order_monkey) |> 
  mutate(number_last = as.double(NA))


# start while loop
while(nrow(still_equation) > 0) {

# see if all child monkeys have been replaced by a number
  
working <- still_equation |> 
  left_join(monkey_numbers, by = 'monkey_name') |> 
  group_by(monkey) |> 
  mutate(
    number = coalesce(number, number_last),
    fully = sum(is.na(number)) == 0
  ) |> 
  ungroup()

# add the newly calculated monkey numbers back
monkey_numbers <- working |> 
  filter(fully) |> 
  group_by(monkey)  |> 
  mutate(
    tot_number = case_when(
      equation == '+' ~ first(number) + last(number),
      equation == '-' ~ first(number) - last(number),
      equation == '*' ~ first(number) * last(number),
      equation == '/' ~ first(number) / last(number)
    )
  ) |> 
  ungroup() |> 
  distinct(monkey_name  = monkey, number = tot_number) |> 
  bind_rows(monkey_numbers)

# remove these monkeys from the list
still_equation <- working |> 
  filter(!fully) |> 
  mutate(number_last = number) |> 
  select(-number)

# end while
}

# find the number for the root monkey
root_number <- monkey_numbers |> 
  filter(monkey_name == 'root') |> 
  pull(number)

stars <- stars + 1

The number called by monkey root is 152. *

Code

monkey_numbers <- df_21 |> 
  filter(type == 'Number') |> 
  transmute(
    monkey_name = monkey, 
    number = parse_number(equation),
    cycle = 0,
    use_humn = if_else(monkey == 'humn', 1, 0)
  )

still_equation <- df_21 |> 
  filter(type == 'Monkeys') |> 
  separate(equation, sep = '\\s', into = c('m_1', 'equation', 'm_2')) |> 
  gather(
    c(m_1, m_2),
    key = order_monkey,
    value = monkey_name
  ) |> 
  arrange(monkey, order_monkey) |> 
  mutate(
    number_last = as.double(NA),
    cycle_last = 0
  )


# start while loop
while(nrow(still_equation) > 2) {

# see if all child monkeys have been replaced by a number
  
working <- still_equation |> 
  left_join(monkey_numbers, by = 'monkey_name') |> 
  group_by(monkey) |> 
  mutate(
    number = coalesce(number, number_last),
    fully = sum(is.na(number)) == 0,
    cycle = pmax(coalesce(cycle, 0), cycle_last)
  ) |> 
  ungroup()

# add the newly calculated monkey numbers back
monkey_numbers <- working |> 
  filter(fully) |> 
  group_by(monkey)  |> 
  mutate(
    tot_number = case_when(
      equation == '+' ~ first(number) + last(number),
      equation == '-' ~ first(number) - last(number),
      equation == '*' ~ first(number) * last(number),
      equation == '/' ~ first(number) / last(number)
    ),
    use_humn = max(use_humn),
    cycle = max(cycle) + 1
  ) |> 
  ungroup() |> 
  distinct(monkey_name  = monkey, number = tot_number, use_humn, cycle) |> 
  bind_rows(monkey_numbers) |>
  distinct()

# remove these monkeys from the list
still_equation <- working |> 
  filter(!fully) |> 
  mutate(
    number_last = number,
    cycle_last = cycle
  ) |> 
  select(-number, -use_humn, -cycle)

# end while
}

#find the number the path should equate to

final <- still_equation |> 
  left_join(monkey_numbers, by = 'monkey_name') |> 
  group_by(monkey) |> 
  mutate(
    number = coalesce(number, number_last),
    fully = sum(is.na(number)) == 0,
    cycle = pmax(coalesce(cycle, 0), cycle_last)
  ) |> 
  ungroup() |>
  filter(use_humn == 0) |>
  pull(number)

# get the final summary of monkeys

final_monkey_numbers <- working |> 
  filter(fully) |> 
  group_by(monkey)  |> 
  mutate(
    tot_number = case_when(
      equation == '+' ~ first(number) + last(number),
      equation == '-' ~ first(number) - last(number),
      equation == '*' ~ first(number) * last(number),
      equation == '/' ~ first(number) / last(number)
    ),
    use_humn = max(use_humn),
    cycle = max(cycle) + 1
  ) |> 
  ungroup() |> 
  distinct(monkey_name  = monkey, number = tot_number, use_humn, cycle) |> 
  bind_rows(monkey_numbers) |>
  distinct() |>
  arrange(use_humn, cycle)

# reverse the equation

get_equation <- df_21 |> 
  filter(type == 'Monkeys') |> 
  separate(equation, sep = '\\s', into = c('m_1', 'equation', 'm_2')) |> 
  gather(
    c(m_1, m_2),
    key = order_monkey,
    value = monkey_name
  ) |>
  select(-type) |>
  left_join(
    final_monkey_numbers |> select(monkey_name, use_humn, number, cycle), 
    by = 'monkey_name'
  ) |>
  group_by(monkey) |>
  filter(
    max(use_humn) == 1) |>
  mutate(max_cycle = max(cycle)) |>
  filter(
    ! (monkey == 'root' & use_humn == 1)
  ) |>
  ungroup() |> 
  arrange(-max_cycle, order_monkey)|>
  select(-max_cycle, cycle) |>
  mutate(
    number = if_else(monkey_name == 'humn', as.double(NA), number)
  ) |>
  filter(monkey != 'root') |>
  pivot_wider(
    id_cols = c(monkey, equation),
    names_from = order_monkey,
    values_from = c(monkey_name, use_humn, number)
  )

# loop through to solve

for_looping <- get_equation 

calc_string <- paste(final)

l <- 0

# loop

while(nrow(for_looping) > 0) {

l <- l + 1

# take the first line

calc_string <- for_looping |>
  filter(row_number() == 1) |>
  mutate(
    # string so far
    calc_string = paste0('(', calc_string, ')'),
    # reverse equation
    calc_string = case_when (
      equation == '+' ~ paste0(
        calc_string, 
        '-',
        if_else(use_humn_m_1 == 1, number_m_2, number_m_1)
      ),
      equation == '*' ~ paste0(
        calc_string, 
        '/',
        if_else(use_humn_m_1 == 1, number_m_2, number_m_1)
      ),    equation == '/' & use_humn_m_1 == 1 ~ paste0(
        calc_string, 
        '*',
        number_m_2
      ),
    equation == '/' ~ paste0(
        number_m_1,
        '/',
        calc_string
      ),
    equation == '-' & use_humn_m_1 == 0 ~ paste0(
        '(',
        calc_string, 
        '-',
        number_m_1,
        ') * -1'
      ),
    equation == '-' ~ paste0(
        calc_string, 
        '+',
        number_m_2
      )
    ),
    x = eval(parse(text = calc_string)) |>
      as.character()

  ) |>
  pull(x)


for_looping <- for_looping |>
  filter(row_number() != 1)

# end loop
}

humn <- eval(parse(text = calc_string))

stars <- stars + 1

The number monkey humn calls out is 301. *

Day 22

Monkey Map

Code

df_22 <- tibble(lines = readLines('inputs/day22.txt'))


# board dimensions --------------------------------------------------------

map_22 <- df_22 |> 
  mutate(
    row = row_number()
  ) |> 
  filter(row < n() - 1) |> 
  mutate(
    board = str_split(lines, pattern = '')
  ) |> 
  unnest_longer(board) |> 
  group_by(row) |> 
  mutate(col = row_number()) |> 
  ungroup() |> 
  filter(board != ' ') |> 
  select(-lines) 

# plot board --------------------------------------------------------------

map_22 |> 
  ggplot(aes(x = col, y = row, label = board)) +
  geom_text() +
  scale_y_reverse() +
  labs(
    x = NULL, y = NULL,
    title = 'Monkey map'
  ) +
  theme_aoc_null() +
  coord_fixed()

Code

# get path directions -----------------------------------------------------

path <- df_22 |> 
  filter(row_number() == n()) |>
  mutate(
    nums = str_split(lines, pattern = 'R|L'),
    direction = str_split(lines, pattern = '[:digit:]+'),
    direction = map(direction, ~head(.x, -1)),
  ) |> 
  unnest_longer(c(direction, nums)) |> 
  mutate(turn = row_number()) |> 
  select(-lines) 

# wrap modulus function ---------------------------------------------------

mod_shift <- function(num, base) {
  ((num - 1) %% base) + 1
}

# starting ----------------------------------------------------------------

current_coords <- map_22 |> 
  filter(row == 1) |> 
  filter(col == min(col)) |> 
  select(row, col) |> 
  as.list()

current_dir <- 'e'

markers <- c('n' = '^', 'e' = '>', 'w' = '<', 's' = 'v')

Day 25 *

Full of hot air

Code

# read in file ------------------------------------------------------------

df_25 <- tibble(lines = readLines('inputs/day25.txt')) |> 
  mutate(
    row = row_number(),
    code = str_split(lines, pattern = '')
  ) |> 
  group_by(row) |> 
  unnest(code) |> 
  mutate(power5 = n() - row_number()) |> 
  select(-lines) |> 
  ungroup() 


# mapping of code to decimal ----------------------------------------------

code5 <- tibble(
  code = c('=', '-', '0', '1', '2'),
  normal = c(-2, -1,0, 1, 2)
)


# convert to decimal number -----------------------------------------------

converted <- df_25 |> 
  inner_join(code5, by = 'code') |> 
  mutate(
    powered = 5 ^ power5,
    converted = powered * normal
  ) |> 
  group_by(row) |> 
  summarise(converted = sum(converted)) |> 
  ungroup() |> 
  summarise(converted = sum(converted)) |> 
  pull(converted)


# find the number of powers of 5 ------------------------------------------

num_inter <- floor(log(converted, 5))
val <- converted
track_it <- c()

for(i in num_inter:0) {
  
  start <- val
  power <- 5^i
  val_plus <- val + (power/2)
  step <- val_plus %/% power
  val <- val - (step * power)
  code <- code5 |> 
    filter(normal == step) |> 
    pull(code)

  track_it <- c(track_it, code)
}

stars <- stars + 1

The SNAFU number is 2=-1=0. *

Total stars

The total number of stars earned is 23.

Learnings

To do

• Tried to include an r script with chunk option code or file but didn’t have any luck

Potential improvements

• Using a PAT for Github access from RStudio Cloud is painful
• Circle back to improve after reviewing other peoples code.
• Use the same Fira Code font for the charts
• Remove the warnings from the quarto run
• Note the things I’ve learned

Source code

The source code can be found at github.com/JoDudding/advent-of-code.

Last year’s advent of code (that I’m doing this year) can be found here.