Task 20

2025-12-23

1 Setup

1.1 Libraries

library(httr)
library(xml2)
library(magrittr)
library(dplyr)
library(purrr)
library(stringr)
library(igraph)
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)
  }
  maze <- text_block %>% 
    str_split("") %>% 
    do.call(rbind, .)
  n <- nrow(maze)
  m <- ncol(maze)
  hole <- apply(maze, 1L, \(r) sum(r %in% c(".", "#")))
  rng <- range(hole)
  hole_rows <- which(!hole %in% rng) %>% 
    range()
  row_idx <- c(1L, hole_rows[1L], hole_rows[2L] - 1L, n - 1L)
  rows <- apply(maze[row_idx, ], 1L, str_which, "[A-Z]")
  
  hole <- apply(maze, 2L, \(r) sum(r %in% c(".", "#")))
  rng <- range(hole)
  hole_cols <- which(!hole %in% rng) %>% 
    range()
  col_idx <- c(1L, hole_cols[1L],hole_cols[2L] - 1L, m - 1L)
  cols <- apply(maze[, col_idx], 2L, str_which, "[A-Z]")
  offset <- 1L
  for (ri in seq_along(row_idx)) {
    i <- row_idx[ri]
    ci <- rows[[ri]]
    maze[i + offset, ci] <- apply(maze[seq(i, length.out = 2L), ci], 2L, 
                                  paste0, collapse = "")
    maze[i + offset, ci - 1L] <- "#"
    maze[i + offset, ci + 1L] <- "#"
    offset <- (offset + 1L) %% 2L
    maze[i + offset, ci] <- "#"
    maze[i + offset, ci - 1L] <- "#"
    maze[i + offset, ci + 1L] <- "#"
  }
  for (ci in seq_along(col_idx)) {
    j <- col_idx[ci]
    ri <- cols[[ci]]
    maze[ri, j + offset] <- apply(maze[ri, seq(j, length.out = 2L)], 1L,
                                  paste0, collapse = "")
    maze[ri - 1L, j + offset] <- "#"
    maze[ri + 1L, j + offset] <- "#"
    offset <- (offset + 1L) %% 2L
    maze[ri, j + offset] <- "#"
    maze[ri - 1L, j + offset] <- "#"
    maze[ri + 1L, j + offset] <- "#"
  }
  ## recode portals to 1 LETTER 
  all_portals <- str_extract(maze, "..") %>% 
    na.omit() %>% 
    unique() %>% 
    sort()
  lkp <- c(LETTERS, letters[seq(1L, length.out = length(all_portals) - 26L)]) %>% 
    set_names(all_portals) %>% 
    c("." = ".", " " = " ", "#" = "#", .)
  maze[] <- lkp[c(maze)]
  warp <- map(lkp[-(1:3)], function(ptl) {
    which(maze == ptl, arr.ind = TRUE)
  }) %>% 
    set_names(lkp[-(1:3)])
  structure(maze, class = "maze", start = "A", goal = tail(lkp, 1L), warp = warp)
}

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

2 Puzzle Day 20

2.1 Part 1

2.1.1 Description

— Day 20: Donut Maze —

You notice a strange pattern on the surface of Pluto and land nearby to get a closer look. Upon closer inspection, you realize you’ve come across one of the famous space-warping mazes of the long-lost Pluto civilization!

Because there isn’t much space on Pluto, the civilization that used to live here thrived by inventing a method for folding spacetime. Although the technology is no longer understood, mazes like this one provide a small glimpse into the daily life of an ancient Pluto citizen.

This maze is shaped like a donut. Portals along the inner and outer edge of the donut can instantly teleport you from one side to the other. For example:

         A           
         A           
  #######.#########  
  #######.........#  
  #######.#######.#  
  #######.#######.#  
  #######.#######.#  
  #####  B    ###.#  
BC...##  C    ###.#  
  ##.##       ###.#  
  ##...DE  F  ###.#  
  #####    G  ###.#  
  #########.#####.#  
DE..#######...###.#  
  #.#########.###.#  
FG..#########.....#  
  ###########.#####  
             Z       
             Z

This map of the maze shows solid walls (#) and open passages (.). Every maze on Pluto has a start (the open tile next to AA) and an end (the open tile next to ZZ). Mazes on Pluto also have portals; this maze has three pairs of portals: BC, DE, and FG. When on an open tile next to one of these labels, a single step can take you to the other tile with the same label. (You can only walk on . tiles; labels and empty space are not traversable.)

One path through the maze doesn’t require any portals. Starting at AA, you could go down 1, right 8, down 12, left 4, and down 1 to reach ZZ, a total of 26 steps.

However, there is a shorter path: You could walk from AA to the inner BC portal (4 steps), warp to the outer BC portal (1 step), walk to the inner DE (6 steps), warp to the outer DE (1 step), walk to the outer FG (4 steps), warp to the inner FG (1 step), and finally walk to ZZ (6 steps). In total, this is only 23 steps.

Here is a larger example:

                   A               
                   A               
  #################.#############  
  #.#...#...................#.#.#  
  #.#.#.###.###.###.#########.#.#  
  #.#.#.......#...#.....#.#.#...#  
  #.#########.###.#####.#.#.###.#  
  #.............#.#.....#.......#  
  ###.###########.###.#####.#.#.#  
  #.....#        A   C    #.#.#.#  
  #######        S   P    #####.#  
  #.#...#                 #......VT
  #.#.#.#                 #.#####  
  #...#.#               YN....#.#  
  #.###.#                 #####.#  
DI....#.#                 #.....#  
  #####.#                 #.###.#  
ZZ......#               QG....#..AS
  ###.###                 #######  
JO..#.#.#                 #.....#  
  #.#.#.#                 ###.#.#  
  #...#..DI             BU....#..LF
  #####.#                 #.#####  
YN......#               VT..#....QG
  #.###.#                 #.###.#  
  #.#...#                 #.....#  
  ###.###    J L     J    #.#.###  
  #.....#    O F     P    #.#...#  
  #.###.#####.#.#####.#####.###.#  
  #...#.#.#...#.....#.....#.#...#  
  #.#####.###.###.#.#.#########.#  
  #...#.#.....#...#.#.#.#.....#.#  
  #.###.#####.###.###.#.#.#######  
  #.#.........#...#.............#  
  #########.###.###.#############  
           B   J   C               
           U   P   P

Here, AA has no direct path to ZZ, but it does connect to AS and CP. By passing through AS, QG, BU, and JO, you can reach ZZ in 58 steps.

In your maze, how many steps does it take to get from the open tile marked AA to the open tile marked ZZ?

2.1.2 Solution

We solve the first part by a straight forward BFS, where we just have to make sure that entering a warp field moves the current position on the field before the warp field.

print.maze <- function(x, ...) {
  apply(x, 1, paste, collapse = "") %>% 
    paste(collapse = "\n") %>% 
    cat()
  invisible(x)
}

find_shortest_path <- function(maze = puzzle_data) {
  dir <- rbind(
    "^" = c(-1L, 0L),
    ">" = c(0L, 1L),
    "v" = c(1L, 0L),
    "<" = c(0L, -1L)
  )
  
  warp <- attr(maze, "warp")
  start <- attr(maze, "start")
  goal <- attr(maze, "goal")
  
  walk_out <- function(pos) {
    for (i in seq_len(nrow(dir))) {
      new_pos <- pos + dir[i, , drop = FALSE]
      if (maze[new_pos] == ".") {
        return(new_pos)
      }
    }
  }
  n <- nrow(maze)
  m <- ncol(maze)
  dist <- matrix(-1L, n, m)
  start_pos <- which(maze == start, arr.ind = TRUE) 
  dist[start_pos] <- 0L
  start_pos <- walk_out(start_pos)
  dist[start_pos] <- 0L
  queue <- matrix(NA_integer_, n * m, 2L)
  head_ptr <- tail_ptr <- 1L
  queue[head_ptr, ] <- start_pos
  while (head_ptr <= tail_ptr) {
    cur_pos <- queue[head_ptr, , drop = FALSE]
    head_ptr <- head_ptr + 1L
    nbs <- t(t(dir) + c(cur_pos))
    valid_nbs <- between(nbs[, 1L], 1L, n) &
      between(nbs[, 2L], 1L, m) &
      !maze[nbs] %in% c(" ", "#") &
      dist[nbs] == -1L
    nbs <- nbs[valid_nbs, , drop = FALSE]
    for (i in seq_len(nrow(nbs))) {
      nb <- nbs[i, , drop = FALSE]
      if (maze[nb] == goal) {
        return(dist[cur_pos])
      } else if (maze[nb] %in% names(warp)) {
        # warp
        targets <- warp[[maze[nb]]]
        dist[nb] <- dist[cur_pos]
        for (j in seq_len(nrow(targets))) {
          target <- targets[j, , drop = FALSE]
          if (!all(target == nb)) {
            dist[target] <- dist[cur_pos]
            nb <- walk_out(target)
            break
          }
        }
      }
      dist[nb] <- dist[cur_pos] + 1L
      tail_ptr <- tail_ptr + 1L
      queue[tail_ptr, ] <- nb
    }
  }
  NA_integer_
}

find_shortest_path(puzzle_data)

## [1] 636

2.2 Part 2

2.2.1 Description

— Part Two —

Strangely, the exit isn’t open when you reach it. Then, you remember: the ancient Plutonians were famous for building recursive spaces.

The marked connections in the maze aren’t portals: they physically connect to a larger or smaller copy of the maze. Specifically, the labeled tiles around the inside edge actually connect to a smaller copy of the same maze, and the smaller copy’s inner labeled tiles connect to yet a smaller copy, and so on.

When you enter the maze, you are at the outermost level; when at the outermost level, only the outer labels AA and ZZ function (as the start and end, respectively); all other outer labeled tiles are effectively walls. At any other level, AA and ZZ count as walls, but the other outer labeled tiles bring you one level outward.

Your goal is to find a path through the maze that brings you back to ZZ at the outermost level of the maze.

In the first example above, the shortest path is now the loop around the right side. If the starting level is 0, then taking the previously-shortest path would pass through BC (to level 1), DE (to level 2), and FG (back to level 1). Because this is not the outermost level, ZZ is a wall, and the only option is to go back around to BC, which would only send you even deeper into the recursive maze.

In the second example above, there is no path that brings you to ZZ at the outermost level.

Here is a more interesting example:

             Z L X W       C                 
             Z P Q B       K                 
  ###########.#.#.#.#######.###############  
  #...#.......#.#.......#.#.......#.#.#...#  
  ###.#.#.#.#.#.#.#.###.#.#.#######.#.#.###  
  #.#...#.#.#...#.#.#...#...#...#.#.......#  
  #.###.#######.###.###.#.###.###.#.#######  
  #...#.......#.#...#...#.............#...#  
  #.#########.#######.#.#######.#######.###  
  #...#.#    F       R I       Z    #.#.#.#  
  #.###.#    D       E C       H    #.#.#.#  
  #.#...#                           #...#.#  
  #.###.#                           #.###.#  
  #.#....OA                       WB..#.#..ZH
  #.###.#                           #.#.#.#  
CJ......#                           #.....#  
  #######                           #######  
  #.#....CK                         #......IC
  #.###.#                           #.###.#  
  #.....#                           #...#.#  
  ###.###                           #.#.#.#  
XF....#.#                         RF..#.#.#  
  #####.#                           #######  
  #......CJ                       NM..#...#  
  ###.#.#                           #.###.#  
RE....#.#                           #......RF
  ###.###        X   X       L      #.#.#.#  
  #.....#        F   Q       P      #.#.#.#  
  ###.###########.###.#######.#########.###  
  #.....#...#.....#.......#...#.....#.#...#  
  #####.#.###.#######.#######.###.###.#.#.#  
  #.......#.......#.#.#.#.#...#...#...#.#.#  
  #####.###.#####.#.#.#.#.###.###.#.###.###  
  #.......#.....#.#...#...............#...#  
  #############.#.#.###.###################  
               A O F   N                     
               A A D   M

One shortest path through the maze is the following:

Walk from AA to XF (16 steps)
Recurse into level 1 through XF (1 step)
Walk from XF to CK (10 steps)
Recurse into level 2 through CK (1 step)
Walk from CK to ZH (14 steps)
Recurse into level 3 through ZH (1 step)
Walk from ZH to WB (10 steps)
Recurse into level 4 through WB (1 step)
Walk from WB to IC (10 steps)
Recurse into level 5 through IC (1 step)
Walk from IC to RF (10 steps)
Recurse into level 6 through RF (1 step)
Walk from RF to NM (8 steps)
Recurse into level 7 through NM (1 step)
Walk from NM to LP (12 steps)
Recurse into level 8 through LP (1 step)
Walk from LP to FD (24 steps)
Recurse into level 9 through FD (1 step)
Walk from FD to XQ (8 steps)
Recurse into level 10 through XQ (1 step)
Walk from XQ to WB (4 steps)
Return to level 9 through WB (1 step)
Walk from WB to ZH (10 steps)
Return to level 8 through ZH (1 step)
Walk from ZH to CK (14 steps)
Return to level 7 through CK (1 step)
Walk from CK to XF (10 steps)
Return to level 6 through XF (1 step)
Walk from XF to OA (14 steps)
Return to level 5 through OA (1 step)
Walk from OA to CJ (8 steps)
Return to level 4 through CJ (1 step)
Walk from CJ to RE (8 steps)
Return to level 3 through RE (1 step)
Walk from RE to IC (4 steps)
Recurse into level 4 through IC (1 step)
Walk from IC to RF (10 steps)
Recurse into level 5 through RF (1 step)
Walk from RF to NM (8 steps)
Recurse into level 6 through NM (1 step)
Walk from NM to LP (12 steps)
Recurse into level 7 through LP (1 step)
Walk from LP to FD (24 steps)
Recurse into level 8 through FD (1 step)
Walk from FD to XQ (8 steps)
Recurse into level 9 through XQ (1 step)
Walk from XQ to WB (4 steps)
Return to level 8 through WB (1 step)
Walk from WB to ZH (10 steps)
Return to level 7 through ZH (1 step)
Walk from ZH to CK (14 steps)
Return to level 6 through CK (1 step)
Walk from CK to XF (10 steps)
Return to level 5 through XF (1 step)
Walk from XF to OA (14 steps)
Return to level 4 through OA (1 step)
Walk from OA to CJ (8 steps)
Return to level 3 through CJ (1 step)
Walk from CJ to RE (8 steps)
Return to level 2 through RE (1 step)
Walk from RE to XQ (14 steps)
Return to level 1 through XQ (1 step)
Walk from XQ to FD (8 steps)
Return to level 0 through FD (1 step)
Walk from FD to ZZ (18 steps)

This path takes a total of 396 steps to move from AA at the outermost layer to ZZ at the outermost layer.

In your maze, when accounting for recursion, how many steps does it take to get from the open tile marked AA to the open tile marked ZZ, both at the outermost layer?

2.2.2 Solution

For the second part we use an A*-algorithm. For this we first calculate the distances from each warp point to all its reachable other warp points. As the position (inner vs outer) of the warp points becomes important now, we rename the warp points and add suffixes _i and _o for inner and outer warp points respectively.

refactor_maze <- function(maze) {
  n <- nrow(maze)
  m <- ncol(maze)
  is_outer <- function(pos) {
    pos[, 1L] %in% c(2L, n - 1) |
      pos[, 2L] %in% c(2L, m - 1)
  }
  start <- attr(maze, "start")
  goal <- attr(maze, "goal")
  warp <- attr(maze, "warp")
  iwalk(warp, function(pos, wp) {
    new_wp <- paste0(wp, if_else(is_outer(pos), "_o", "_i"))  
    maze[pos] <<- new_wp
  })
  warp <- str_extract(maze, "^._[io]$")
  maze <- structure(c(maze), 
                    dim = dim(maze), 
                    warp = warp[!is.na(warp)],
                    start = paste0(start, "_o"),
                    goal = paste0(goal, "_o"))
  maze
}


bfs <- function(maze, start) {
  dir <- rbind(
    "^" = c(-1L, 0L),
    ">" = c(0L, 1L),
    "v" = c(1L, 0L),
    "<" = c(0L, -1L)
  )
  
  warp <- attr(maze, "warp")
  
  walk_out <- function(pos) {
    for (i in seq_len(nrow(dir))) {
      new_pos <- pos + dir[i, , drop = FALSE]
      if (maze[new_pos] == ".") {
        return(new_pos)
      }
    }
  }
  n <- nrow(maze)
  m <- ncol(maze)
  start_pos <- which(maze == start, arr.ind = TRUE)
  dist <- matrix(-1L, n, m)
  dist[start_pos] <- 0L
  start_pos <- walk_out(start_pos)
  dist[start_pos] <- 0L
  queue <- matrix(NA_integer_, n * m, 2L)
  head_ptr <- tail_ptr <- 1L
  queue[head_ptr, ] <- start_pos
  res <- tibble(from = character(0L),
                to = character(0L),
                distance = integer(0L))
  while (head_ptr <= tail_ptr) {
    cur_pos <- queue[head_ptr, , drop = FALSE]
    head_ptr <- head_ptr + 1L
    nbs <- t(t(dir) + c(cur_pos))
    valid_nbs <- between(nbs[, 1L], 1L, n) &
      between(nbs[, 2L], 1L, m) &
      !maze[nbs] %in% c(" ", "#") &
      dist[nbs] == -1L
    nbs <- nbs[valid_nbs, , drop = FALSE]
    for (i in seq_len(nrow(nbs))) {
      nb <- nbs[i, , drop = FALSE]
      if (maze[nb] %in% warp) {
        dist[nb] <- dist[cur_pos]
        res <- add_row(res,
                       from = start,
                       to = maze[nb],
                       distance = dist[cur_pos])
      }
      dist[nb] <- dist[cur_pos] + 1L
      tail_ptr <- tail_ptr + 1L
      queue[tail_ptr, ] <- nb
    }
  }
  res
}

precompute_distances <- function(maze = puzzle_data) {
  maze <- refactor_maze(maze)
  warp <- attr(maze, "warp")
  poi <- attributes(maze)[c("start", "goal")] %>% 
    unlist() %>% 
    unname()
  stairs <- setdiff(warp, poi) %>% 
    str_remove("_[io]$") %>% 
    unique() %>% 
    sort()
  stairs <- tibble(from = c(paste0(stairs, "_i"),
                            paste0(stairs, "_o")),
                   to = c(paste0(stairs, "_o"),
                            paste0(stairs, "_i")),
                   distance = 1L)
  res <- map(warp, ~ bfs(maze, .x)) %>% 
    list_rbind() %>% 
    rbind(stairs) %>% 
    filter(!((from %in% poi & str_detect(to, "_o$")) | 
               (to %in% poi & str_detect(from, "_o$"))))
  attr(res, "start") <- poi[1L]
  attr(res, "goal") <- poi[2L]
  res
}

warp_distances <- precompute_distances(puzzle_data)

With the distances pre-computed we can plot the network:

We see that we can further reduce the graph. Take the sequence X_i -> X_o -> O_i -> O_o -> E_i -> E_o for instance. Each of the nodes (except the very first one) has exactly one descendant. We can collapse these nodes by summing their distance, removing the nodes, and adding a simple new edge between X_o and E_o with the updated weight.

compress_network <- function(dist) {
  queue <- rep(NA_character_, dist %>% 
                    pull(from) %>% 
                    unique() %>% 
                    length())
  head_ptr <- tail_ptr <- 1L
  queue[head_ptr] <- attr(dist, "start")

  res <- dist[0L, ] %>% 
    cbind(levels = integer(0L))
  skip <- tibble(from = character(0L), to = character(0L))
  while (head_ptr <= tail_ptr) {
    cur <- queue[head_ptr]
    head_ptr <- head_ptr + 1L
    cands <- dist %>% 
      filter(from == cur) %>% 
      anti_join(skip, c("from", "to"))
    for (i in seq_len(nrow(cands))) {
      cand <- cands %>% 
        slice(i)
      weight <- cand %>% 
        pull(distance)
      start <- parent <- cand %>% 
        pull(from)
      kid <- cand %>% 
        pull(to)
      levels <- 0L
      while (TRUE) {
        kids <- dist %>% 
          filter(from == kid, to != parent)
        if (str_remove(parent, "_[io]$") == str_remove(kid, "_[io]$")) {
          if (str_detect(parent, "_i$")) {
            levels <- levels - 1L
          } else {
            levels <- levels + 1L
          }
        }
        
        if (nrow(kids) > 1L || nrow(kids) == 0L) {
          res <- rbind(res, 
                       tibble(from = c(start, kid), 
                              to = c(kid, start), distance = weight, 
                              levels = c(levels, -levels)))
          skip <- rbind(skip, 
                        tibble(from = c(kid, parent), to = c(parent, kid)))
          if (!kid %in% queue) {
            tail_ptr <- tail_ptr + 1L
            queue[tail_ptr] <- kid
          }
          break
        } else {
          parent <- kid
          kid <- kids %>% 
            pull(to)
          weight <- weight + kids %>% 
            pull(distance)
        }

      }
    }
  }
  attr(res, "start") <- attr(dist, "start")
  attr(res, "goal") <- attr(dist, "goal")
  res
}
compressed_distances <- compress_network(warp_distances)

This compressed graph looks like this (the edges are labeled by the distance / level change):

We just have to be careful to not allow using the path X_i -> W_i on the ground level of the maze, as it would pass through D_o which is not existing on the ground floor. Likewise we must not use the edge H_i -> c_o on any other floor than the ground floor. In general, we must not use edges which would lead to a non-existing floor > 0 (A_o -> X_i -> E_o -> W_i -> X_i for example). This rule also ensures that we do not use the illegal edge on level 0. The special rule for entering the exit (H_i -> c_o) must be checked however on each turn.

With this setup we are ready to implement an A-Star search where the current portal and the current floor form the state. We use the current floor times the minimum distance as heuristic h (it will never overestimate the real costs).

a_star_search <- function(dist) {
  pq <- priority_queue()
  costs <- new.env(parent = emptyenv())
  d_min <- dist %>% 
    pull(distance) %>% 
    min()
  h <- function(state) {
    abs(state$level) * d_min
  }
  get_key <- function(state) {
    sprintf("%s_%d", state$pos, state$level)
  }
  
  goal  <- attr(dist, "goal")
  start <- list(pos = attr(dist, "start"), level = 0L)
  start_key <- get_key(start)

  costs[[start_key]] <- 0
  pq$push(start, -(costs[[start_key]] + h(start)))

  while(pq$size() > 0) {
    cur <- pq$pop()
    cur_key <- get_key(cur)
    g_cur <- costs[[cur_key]]
    
    if (cur$pos == goal) {
      return(costs[[cur_key]])
    }
    
    cands <- dist %>% 
      mutate(new_level = cur$level + levels) %>% 
      filter(from == cur$pos, new_level <= 0L) 
    if (cur$level < 0L) {
      ## we must not use H_i -> c_o on any level other than 0
      cands <- cands %>% 
        filter(!(from == "H_i" & to == "c_o"))
    }
    for (i in seq_len(nrow(cands))) {
      to_node   <- cands$to[i]
      new_level <- cands$new_level[i]
      dis       <- cands$distance[i]

      new_state <- list(pos = to_node, level = new_level)
      new_key   <- get_key(new_state)
      if (!exists(new_key, costs, inherits = FALSE)) {
        costs[[new_key]] <- Inf
      }
      tentative_g <- g_cur + dis
      if (tentative_g < costs[[new_key]]) {
        costs[[new_key]] <- tentative_g
        f <- -(tentative_g + h(new_state))
        pq$push(new_state, f)
      }
    }
  }
}
a_star_search(compressed_distances)

## [1] 7248