Task 18

2025-01-08

1 Setup

1.1 Libraries

library(httr)
library(xml2)
library(magrittr)
library(dplyr)
library(purrr)
library(stringr)
library(knitr)
library(cli)
library(bit64)
library(igraph)

1.2 Retrieve Data from `AoC`

session_cookie <- set_cookies(session = keyring::key_get("AoC-GitHub-Cookie"))
base_url <- paste0("https://adventofcode.com/2024/day/", params$task_nr)
puzzle <- GET(base_url,
              session_cookie) %>% 
  content(encoding = "UTF-8") %>% 
  xml_find_all("///article") %>% 
  lapply(as.character)

parse_puzzle_data <- function(text_block = readClipboard()) {
  if (length(text_block) == 1L) {
    text_block <- text_block %>% 
      str_split("\n") %>% 
      extract2(1L) %>% 
      keep(nzchar)
  } 
  res <- text_block %>% 
    str_split(fixed(",")) %>% 
    lapply(as.integer) %>% 
    do.call(rbind, .) %>% 
    set_colnames(c("x", "y")) 
  res[, c(2, 1)] + 1L
}

puzzle_data <- local({
  GET(paste0(base_url, "/input"),
      session_cookie) %>% 
    content(encoding = "UTF-8") %>% 
    parse_puzzle_data()
})
attr(puzzle_data, "dims") <- c(71, 71)

2 Puzzle Day 18

2.1 Part 1

2.1.1 Description

— Day 18: RAM Run —

You and The Historians look a lot more pixelated than you remember. You’re inside a computer at the North Pole!

Just as you’re about to check out your surroundings, a program runs up to you. “This region of memory isn’t safe! The User misunderstood what a pushdown automaton is and their algorithm is pushing whole bytes down on top of us! Run!”

The algorithm is fast - it’s going to cause a byte to fall into your memory space once every nanosecond! Fortunately, you’re faster, and by quickly scanning the algorithm, you create a list of which bytes will fall (your puzzle input) in the order they’ll land in your memory space.

Your memory space is a two-dimensional grid with coordinates that range from 0 to 70 both horizontally and vertically. However, for the sake of example, suppose you’re on a smaller grid with coordinates that range from 0 to 6 and the following list of incoming byte positions:

5,4
4,2
4,5
3,0
2,1
6,3
2,4
1,5
0,6
3,3
2,6
5,1
1,2
5,5
2,5
6,5
1,4
0,4
6,4
1,1
6,1
1,0
0,5
1,6
2,0

Each byte position is given as an X,Y coordinate, where X is the distance from the left edge of your memory space and Y is the distance from the top edge of your memory space.

You and The Historians are currently in the top left corner of the memory space (at 0,0) and need to reach the exit in the bottom right corner (at 70,70 in your memory space, but at 6,6 in this example). You’ll need to simulate the falling bytes to plan out where it will be safe to run; for now, simulate just the first few bytes falling into your memory space.

As bytes fall into your memory space, they make that coordinate corrupted. Corrupted memory coordinates cannot be entered by you or The Historians, so you’ll need to plan your route carefully. You also cannot leave the boundaries of the memory space; your only hope is to reach the exit.

In the above example, if you were to draw the memory space after the first 12 bytes have fallen (using . for safe and # for corrupted), it would look like this:

...#...
..#..#.
....#..
...#..#
..#..#.
.#..#..
#.#....

You can take steps up, down, left, or right. After just 12 bytes have corrupted locations in your memory space, the shortest path from the top left corner to the exit would take 22 steps. Here (marked with O) is one such path:

OO.#OOO
.O#OO#O
.OOO#OO
...#OO#
..#OO#.
.#.O#..
#.#OOOO

Simulate the first kilobyte (1024 bytes) falling onto your memory space. Afterward, what is the minimum number of steps needed to reach the exit?

2.1.2 Solution

We construct a graph to rely on a “shortest path” algorithm to solve this puzzle. We use make_lattice to make a full lattice graph first and then delete all edges which are incident to a wall. This approach is way fast rather than looping through all entries and creating each edge separately.

show_map <- function(memory_map) {
  apply(memory_map, 1, paste, collapse = "") %>% 
    paste(collapse = "\n") %>% 
    cat("\n")
}

make_vertex_id <- function(coord, end) {
  start <- c(1L, 1L)
  if (all(c(coord) == start)) {
    "S"
  } else if (all(c(coord) == end)) {
    "E"
  } else {
    paste(coord - 1L, collapse = "/")
  }
}

make_memory_map <- function(corrupted_bytes, 
                            subset = 1:nrow(corrupted_bytes)) {
  dd <- attr(corrupted_bytes, "dims")
  map <- matrix(".", dd[1L], dd[2L])
  map[corrupted_bytes[subset, ]] <- "#"
  walls <- which(map == "#", arr.ind = TRUE)
  G <- make_lattice(dd)
  V(G)$name <- expand.grid(
    col = seq(1L, dd[1L]),
    row = seq(dd[2L], 1L)
  ) %>%
    rowwise() %>%
    mutate(id = make_vertex_id(cbind(row, col), dd)) %>%
    pull(id)
  wall_ids <- apply(walls, 1, make_vertex_id, end = dd)
  wall_edges <- do.call(c, incident_edges(G, wall_ids))
  
  V(G)$shape <- if_else(V(G)$name %in% wall_ids, "square", "circle")
  V(G)$color <- case_when(
    V(G)$name %in% wall_ids ~ "darkgray", 
    V(G)$name %in% c("S", "E") ~ "firebrick",
    TRUE ~ "beige")
  V(G)$label.color <- if_else(V(G)$name %in% c("S", "E"), "white", "black")
  G <- G %>% 
    delete_edges(wall_edges)
  G %>% 
    set_graph_attr("layout", layout_on_grid(G)) %>% 
    set_graph_attr("dims", dd) %>% 
    set_graph_attr("data", corrupted_bytes)
}


find_path <- function(memory_map) {
  distances(memory_map, "S", "E")
}

kb_map <- make_memory_map(puzzle_data, 1:1024)
kb_map %>% 
  find_path()

##     E
## S 276

An example graph (after 12 ananoseconds of falling bytes) is visualized below:

example_data <- structure(
  c(5L, 3L, 6L, 1L, 2L, 4L, 5L, 6L, 7L, 4L, 7L, 2L, 3L,
    6L, 6L, 6L, 5L, 5L, 5L, 2L, 2L, 1L, 6L, 7L, 1L, 6L, 
    5L, 5L, 4L, 3L, 7L, 3L, 2L, 1L, 4L, 3L, 6L, 2L, 6L,
    3L, 7L, 2L, 1L, 7L, 2L, 7L, 2L, 1L, 2L, 3L),
  dim = c(25L, 2L), 
  dimnames = list(NULL, c("x", "y")), dims = c(7, 7))

ex_map <- make_memory_map(example_data, 1:12)

plot(ex_map)

2.2 Part 2

2.2.1 Description

— Part Two —

The Historians aren’t as used to moving around in this pixelated universe as you are. You’re afraid they’re not going to be fast enough to make it to the exit before the path is completely blocked.

To determine how fast everyone needs to go, you need to determine the first byte that will cut off the path to the exit.

In the above example, after the byte at 1,1 falls, there is still a path to the exit:

O..#OOO
O##OO#O
O#OO#OO
OOO#OO#
###OO##
.##O###
#.#OOOO

However, after adding the very next byte (at 6,1), there is no longer a path to the exit:

...#...
.##..##
.#..#..
...#..#
###..##
.##.###
#.#....

So, in this example, the coordinates of the first byte that prevents the exit from being reachable are 6,1.

Simulate more of the bytes that are about to corrupt your memory space. What are the coordinates of the first byte that will prevent the exit from being reachable from your starting position? (Provide the answer as two integers separated by a comma with no other characters.)

2.2.2 Solution

With the data stored as graph, the problem reduces to iteratively removing edges and to check at each removal, whether start and end are still connected.

check_critical_byte <- function(map, from_index) {
  dd <- graph_attr(map, "dims")
  data <- graph_attr(map, "data")
  bytes_seq <- seq(from_index, nrow(data))
  res <- NULL
  for (byte_idx in bytes_seq) {
    byte <- data[byte_idx, , drop = FALSE] 
    byte_id <- make_vertex_id(byte, dd)
    byte_edge <- incident(map, byte_id)
    new_map <- map %>% 
      delete_edges(byte_edge)
    V(new_map)$shape[V(new_map)$name == byte_id] <- "square"
    V(new_map)$color[V(new_map)$name == byte_id] <- "darkgray"
    dis <- c(distances(new_map, "S", "E"))
    if (is.infinite(dis)) {
      res <- byte
      break
    }
    map <- new_map
  }
  list(res = res[, 2:1] - 1L, before = map, after = new_map)
}

check_critical_byte(kb_map, 1025L)$res

##  x  y 
## 60 37

We can visualize the example before and after the critical byte fell:

ex_cp <- check_critical_byte(ex_map, 13L)
plot(ex_cp$before)
plot(ex_cp$after)