Task 13

2025-09-19

1 Setup

1.1 Libraries

library(httr)
library(xml2)
library(magrittr)
library(dplyr)
library(purrr)
library(stringr)
library(collections)

1.2 Retrieve Data from `AoC`

session_cookie <- set_cookies(session = keyring::key_get("AoC-GitHub-Cookie"))
base_url <- paste0("https://adventofcode.com/", params$year, "/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)
  }
  text_block %>% 
    as.integer()
}

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

2 Puzzle Day 13

2.1 Part 1

2.1.1 Description

— Day 13: A Maze of Twisty Little Cubicles —

You arrive at the first floor of this new building to discover a much less welcoming environment than the shiny atrium of the last one. Instead, you are in a maze of twisty little cubicles, all alike.

Every location in this area is addressed by a pair of non-negative integers (x,y). Each such coordinate is either a wall or an open space. You can’t move diagonally. The cube maze starts at 0,0 and seems to extend infinitely toward positive x and y; negative values are invalid, as they represent a location outside the building. You are in a small waiting area at 1,1.

While it seems chaotic, a nearby morale-boosting poster explains, the layout is actually quite logical. You can determine whether a given x,y coordinate will be a wall or an open space using a simple system:

Find xx + 3x + 2xy + y + y*y.
Add the office designer’s favorite number (your puzzle input).
Find the binary representation of that sum; count the number of bits that are 1.
- If the number of bits that are 1 is even, it’s an open space.
- If the number of bits that are 1 is odd, it’s a wall.

For example, if the office designer’s favorite number were 10, drawing walls as # and open spaces as ., the corner of the building containing 0,0 would look like this:

  0123456789
0 .#.####.##
1 ..#..#...#
2 #....##...
3 ###.#.###.
4 .##..#..#.
5 ..##....#.
6 #...##.###

Now, suppose you wanted to reach 7,4. The shortest route you could take is marked as O:

  0123456789
0 .#.####.##
1 .O#..#...#
2 #OOO.##...
3 ###O#.###.
4 .##OO#OO#.
5 ..##OOO.#.
6 #...##.###

Thus, reaching 7,4 would take a minimum of 11 steps (starting from your current location, 1,1).

What is the fewest number of steps required for you to reach 31,39?

2.1.2 Solution

We use an A Star algorithm with the Manhatten distance as the heuristic.

popcount <- function(n) {
  vapply(n, \(n) sum(as.integer(intToBits(n))), integer(1L))
}

is_wall <- function(coord, key) {
  x <- coord[, 1]
  y <- coord[, 2]
  popcount((x + y) ^ 2L + 3L * x + y + key) %% 2 == 1L
}

get_neighbors <- function(pos, end, visited, wall_fn, key) {
  coords <- c("x", "y")
  dirs <- matrix(c(-1, 0, 1, 0, 0, -1, 0, 1), 4, 2)
  colnames(dirs) <- coords
  nbs <- t(c(pos[, coords]) + t(dirs))
  nbs <- nbs[nbs[, 1L] >= 0L & nbs[, 2L] >= 0L, ]
  was_there <- duplicated(rbind(visited[, coords, drop = FALSE], nbs))[-(1:nrow(visited))]
  nbs <- nbs[!was_there, , drop = FALSE]
  is_free <- !wall_fn(nbs, key)
  nbs <- nbs[is_free, , drop = FALSE]
  if (nrow(nbs) > 0L) {
    nbs <- cbind(nbs, costs = pos[, "costs"] + 1, 
                 heuristic = heuristic(nbs[, coords, drop = FALSE], end))
    rownames(nbs) <- NULL
    nbs
  } else {
    NULL
  }
}

heuristic <- function(pos, end) {
  -rowSums(abs(t(t(pos) - end)))
}

add_to_queue <- function(pq, nbs) {
  coords <- c("x", "y")
  for (i in 1:nrow(nbs)) {
    nb <- nbs[i, , drop = FALSE]
    prio <- nb[, "heuristic"] - nb[, "costs"]
    q_elems <- pq$as_list() %>% 
      lapply(\(x) x[, coords, drop = FALSE])
    if (!list(nb[, coords, drop = FALSE]) %in% q_elems) {
      pq$push(nb, prio)
    }
  }
}

find_shortest_path <- function(start, end, wall_fn = is_wall, key = puzzle_data) {
  pq <- priority_queue()
  start <- matrix(c(start, 0L, 0L), 1L)
  coords <- c("x", "y")
  colnames(start) <- c(coords, "costs", "heuristic")
  visited <- start[, coords, drop = FALSE]
  nbs <- get_neighbors(start, end, visited, wall_fn, key)
  add_to_queue(pq, nbs)
  sol <- NULL
  i <- 1
  while (pq$size() > 0) {
    nb <- pq$pop()
    visited <- rbind(visited, nb[, coords, drop = FALSE])
    if (all(nb[, coords] == end)) {
      sol <- nb
      break
    }
    nbs <- get_neighbors(nb, end, visited, wall_fn, key)
    if (!is.null(nbs)) {
      add_to_queue(pq, nbs)
    }
  }
  sol[, "costs"]
}

find_shortest_path(c(1L, 1L), c(31L, 39L), is_wall, puzzle_data)

## costs 
##    90

2.2 Part 2

2.2.1 Description

— Part Two —

How many locations (distinct x,y coordinates, including your starting location) can you reach in at most 50 steps?

2.2.2 Solution

We reuse the algorithms from before, even though we do not need the heuristic part, simply because we do not have to reinvent the wheel. We add new(!) neighbors if they are within the range and count finally the number of visited nodes.

random_walk <- function(start, limit, wall_fn = is_wall, key = puzzle_data) {
  pq <- priority_queue()
  start <- matrix(c(start, 0L, 0L), 1L)
  coords <- c("x", "y")
  colnames(start) <- c(coords, "costs", "heuristic")
  visited <- start[, c(coords, "costs"), drop = FALSE]
  end <- c(51L, 51L) # needed for unused heuristic
  nbs <- get_neighbors(start, end, visited, wall_fn, key)
  add_to_queue(pq, nbs)
  while (pq$size() > 0) {
    nb <- pq$pop()
    visited <- rbind(visited, nb[, c(coords, "costs"), drop = FALSE])
    nbs <- get_neighbors(nb, end, visited, wall_fn, key)
    if (!is.null(nbs)) {
      nbs <- nbs[nbs[, "costs"] <= limit, , drop = FALSE]
      if (nrow(nbs) > 0L) {
        add_to_queue(pq, nbs)
      }
    }
  }
  nrow(visited)
}
random_walk(c(1L, 1L), 50L, is_wall, puzzle_data)

## [1] 135