Day 17

Advent of Code: Worked Solutions

Setup

# Libraries
library(tidyverse)
library(unglue)
library(bit64)

# Read input from file
input <- read_lines("../input/day17.txt", skip_empty_rows = TRUE) |> 
  unglue_data(patterns = c(
    "{label}: {value}"
  ))

Part 1

Initialize the machine from the text input:

program <- input |> 
  filter(label == "Program") |> 
  pull(value) |> 
  str_split_1(",") |> 
  as.integer()

A <- input |> 
  filter(label == "Register A") |> 
  pull(value) |> 
  as.integer()

B <- input |> 
  filter(label == "Register B") |> 
  pull(value) |> 
  as.integer()

C <- input |> 
  filter(label == "Register C") |> 
  pull(value) |> 
  as.integer()

machine <- list(program = program, A = A, B = B, C = C, pointer = 0L, output = NULL)

Define machine’s helper functions:

combo <- function(machine, operand) {
  case_match(operand,
    0 ~ 0,
    1 ~ 1,
    2 ~ 2,
    3 ~ 3,
    4 ~ machine$A,
    5 ~ machine$B,
    6 ~ machine$C
   )
}

run_opcode <- function(machine, opcode, operand) {
  func <- case_match(opcode, 
    0 ~ "adv",
    1 ~ "bxl",
    2 ~ "bst",
    3 ~ "jnz",
    4 ~ "bxc",
    5 ~ "out",
    6 ~ "bdv",
    7 ~ "cdv"
  )
  
  get(func)(machine, operand)
}

run_machine <- function(machine) {
  while (machine$pointer < length(machine$program)) {
    opcode  <- machine$program[machine$pointer + 1]
    operand <- machine$program[machine$pointer + 2]
    machine <- run_opcode(machine, opcode, operand)
  }
  return(machine$output)
}

Need to define custom bitwise XOR function to handle very large integers without error:

bitwXor64 <- function(x, y) {
  x <- as.bitstring(as.integer64(x))
  y <- as.bitstring(as.integer64(y))
  
  base::xor(
    as.integer(str_split_1(x, "")), 
    as.integer(str_split_1(y, ""))
  ) |> 
    as.integer() |> 
    str_c(collapse = "") |> 
    structure(class = "bitstring") |> 
    as.integer64() |> 
    as.numeric()
}

Define the opcode functions:

adv <- function(machine, operand) {
  machine$A <- floor(machine$A / 2^combo(machine, operand))
  machine$pointer <- machine$pointer + 2
  return(machine)
}

bxl <- function(machine, operand) {
  machine$B <- bitwXor64(machine$B, operand)
  machine$pointer <- machine$pointer + 2
  return(machine)
}

bst <- function(machine, operand) {
  machine$B <- combo(machine, operand) %% 8
  machine$pointer <- machine$pointer + 2
  return(machine)
}

jnz <- function(machine, operand) {
  if (machine$A != 0) 
    machine$pointer <- operand
  else 
    machine$pointer <- machine$pointer + 2
  return(machine)
}

bxc <- function(machine, operand) {
  machine$B <- bitwXor64(machine$B, machine$C)
  machine$pointer <- machine$pointer + 2
  return(machine)
}

out <- function(machine, operand) {
  machine$output <- c(
    machine$output, 
    combo(machine, operand) %% 8
  )
  machine$pointer <- machine$pointer + 2
  return(machine)
}

bdv <- function(machine, operand) {
  machine$B <- floor(machine$A / 2^combo(machine, operand))
  machine$pointer <- machine$pointer + 2
  return(machine)
}

cdv <- function(machine, operand) {
  machine$C <- floor(machine$A / 2^combo(machine, operand))
  machine$pointer <- machine$pointer + 2
  return(machine)
}

Run on puzzle input:

run_machine(machine) |> 
  str_c(collapse = ",")

[1] "3,1,4,3,1,7,1,6,3"

Part 2

Reverse engineer, testing sequences of 3 bits at a time. Thanks to hints from Reddit:

run_machine_a <- function(a) run_machine(list(
  program = program, 
  A = a, 
  B = B, 
  C = C, 
  pointer = 0L, 
  output = NULL
))

reveng <- function(program, digit = 1, a = 0) {
  if (digit > length(program))
    return(a)
  
  df <- tibble(candidates = 8 * a + 0:7) |> 
    mutate(
      output = map(candidates, run_machine_a),
      output = map(output, head, n = 1)
    ) |> 
    filter(output == rev(program)[digit]) |> 
    mutate(
      res = map_dbl(candidates, ~ reveng(program, digit + 1, .x))
    ) |> 
    filter(!is.na(res))
  
  if (nrow(df) == 0) return(Inf)
  else return(min(df$res))
}

reveng(program) |> 
  format(scientific = FALSE)

[1] "37221270076916"