Task 23

2025-04-11

1 Setup

1.1 Libraries

library(httr)
library(xml2)
library(magrittr)
library(dplyr)
library(purrr)
library(stringr)
library(tidyr)
library(igraph)
library(glue)

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 
}

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

2 Puzzle Day 23

2.1 Part 1

2.1.1 Description

— Day 23: Opening the Turing Lock —

Little Jane Marie just got her very first computer for Christmas from some unknown benefactor. It comes with instructions and an example program, but the computer itself seems to be malfunctioning. She’s curious what the program does, and would like you to help her run it.

The manual explains that the computer supports two registers and six instructions (truly, it goes on to remind the reader, a state-of-the-art technology). The registers are named a and b, can hold any non-negative integer, and begin with a value of 0. The instructions are as follows:

hlf r sets register r to half its current value, then continues with the next instruction.
tpl r sets register r to triple its current value, then continues with the next instruction.
inc r increments register r, adding 1 to it, then continues with the next instruction.
jmp offset is a jump; it continues with the instruction offset away relative to itself.
jie r, offset is like jmp, but only jumps if register r is even (“jump if even”).
jio r, offset is like jmp, but only jumps if register r is 1 (“jump if one”, not odd).

All three jump instructions work with an offset relative to that instruction. The offset is always written with a prefix + or - to indicate the direction of the jump (forward or backward, respectively). For example, jmp +1 would simply continue with the next instruction, while jmp +0 would continuously jump back to itself forever.

The program exits when it tries to run an instruction beyond the ones defined.

For example, this program sets a to 2, because the jio instruction causes it to skip the tpl instruction:

inc a
jio a, +2
tpl a
inc a

What is the value in register b when the program in your puzzle input is finished executing?

2.1.2 Solution

To understand the algorithm, we draw it first as a graph.

make_flow_chart <- function(ops) {
  parse_nodes <- function(op) {
    str_match_all(op, "(...) ([^ ,]+)(?:, )?([-+]\\d+)?") %>% 
      do.call(rbind, .) %>% 
      set_colnames(c("string", "op", "reg", "offset")) %>% 
      as_tibble() %>% 
      mutate(id = 1:n(), .before = 1L) %>% 
      mutate(offset = if_else(op == "jmp",  reg, offset),
             reg = if_else(op == "jmp", NA_character_, reg),
             offset = as.integer(offset),
             label = case_when(
               op == "jio" ~ glue("{reg} == 1?"),
               op == "jie" ~ glue("{reg} %% 2 == 0?"),
               op == "inc" ~ glue("{reg}++"),
               op == "tpl" ~ glue("{reg} = 3\U00B7{reg}"),
               op == "hlf" ~ glue("{reg} = {reg} / 2")
             ),
             target = if_else(!is.na(offset), id + offset, NA_integer_))

  }
  ops_data <- parse_nodes(ops)
  ops_data_no_jmp <- ops_data %>% 
    filter(op != "jmp")
  n <-  nrow(ops_data_no_jmp) + 1L ## for exit
  G <- make_empty_graph(n)
  V(G)$name <- ops_data_no_jmp %>% 
    pull(id) %>% 
    paste0("E", .) %>% 
    c(glue("E{nrow(ops_data) + 1L}"))
  V(G)$type <- ops_data_no_jmp %>% 
    pull(op) %>% 
    c("out")
  V(G)$label <- ops_data_no_jmp %>% 
    pull(label) %>% 
    c("Ouput b")
  V(G)$shape <- "rectangle"
  V(G)$size <- case_match(
    V(G)$type,
    "inc" ~ 40L,
    c("tpl", "hlf", "jio") ~ 60L,
    .default = 100L)
  V(G)$size2 <- 65L
  V(G)$color <- case_when(
    V(G)$label == "b++" ~ "firebrick",
    V(G)$type %in% c("jio", "jie") ~ "steelblue",
    V(G)$type %in% c("inc", "tpl", "hlf") ~ "gray80",
    V(G)$type == "out" ~ "forestgreen"
    
  ) 
  V(G)$label.color <- if_else(
    V(G)$color == "gray80", "black", "white"
  )
  double_jmp <- ops_data %>% 
    inner_join(ops_data, c(target = "id")) %>%
    filter(op.y == "jmp") %>% 
    mutate(id, target = target.y, .keep = "none")
  ops_data <- ops_data %>% 
    rows_update(double_jmp, "id")
  edges <- ops_data %>% 
    mutate(
      edge_str = if_else(lead(op) == "jmp", 
                         glue("{id},{lead(target)}"),
                         glue("{id},{if_else(is.na(target), id + 1L, target)}")
      ),
      edge_str = if_else(op %in% c("jio", "jie"),
                         glue("{edge_str},{id},{id + 1L}"),
                         edge_str)
      ) %>% 
    filter(op != "jmp") %>%
    pull(edge_str) %>%
    str_extract_all("\\d+") %>%
    unlist() %>%
    paste0("E", .)
  
  G <- G %>% 
     add_edges(edges)
  E(G)$arrow.size <- .75
  E(G)$arrow.width <- .75
  lay <- matrix(c(0L, -2L, -2L, -2L, -2L, -2L, -2L, -2L, -2L, -2L, 
                  -2L, -2L, -2L, -2L, -2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 
                  2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 0L, -2L, 
                  -2L, -3L, -3L, -1L, 0L, 28L, 27L, 26L, 25L, 24L, 23L, 22L, 21L, 
                  20L, 19L, 18L, 17L, 16L, 15L, 14L, 27L, 26L, 25L, 24L, 23L, 22L, 
                  21L, 20L, 19L, 18L, 17L, 16L, 15L, 14L, 13L, 12L, 11L, 10L, 9L, 
                  8L, 7L, 6L, 5L, 4L, 3L, 2L, 1L, 2L, 0L), ncol = 2L)
  G <- set_graph_attr(G, "layout", lay)
  G <- set_graph_attr(G, "rescale", FALSE)
  G
}

G <- make_flow_chart(puzzle_data) 
plot(G, ylim = c(0, 28), xlim = c(-3.5, 2.5), margin = 0, asp = 0)

We can see that the algorithm calculates a starting value for a (Depending on whether we started with 1 or any other value (0 in our case)) and then does a loop:

If a equals 1 stop.
Else if it is even divide a by 2 otherwise multiply by 3 and add 1.
Repeat.
Return the number of iterations.

This is known as the Collatz conjecture.

For a == 0L the starting value is 4,591.

a0 <- (((0L + 2L) * 27L + 2L) * 3L + 2L) * 27L + 1L
collatz_conjecture <- function(n) {
  b <- 0L
  while (n != 1L) {
    b <- b + 1L
    if (n %% 2L == 0L) {
      n <- n / 2L
    } else {
      n <- 3L * n + 1L
    }
  }
  b
}

collatz_conjecture(a0)

## [1] 170

2.2 Part 2

2.2.1 Description

— Part Two —

The unknown benefactor is very thankful for releasi– er, helping little Jane Marie with her computer. Definitely not to distract you, what is the value in register b after the program is finished executing if register a starts as 1 instead?

2.2.2 Solution

This time we simply walk the other branch which yields another starting value (113,383).

a1 <- ((((((((1L * 3L) + 2L) * 3L + 2L) * 9L + 2L) * 3L + 1L) * 3L + 1L) * 3L + 2L) * 
         3L + 1L) * 9L +1L
collatz_conjecture(a1)

## [1] 247