2022-11: Monkey in the Middle

library(mistlecode)

To install `mistlecode` yourself, run `devtools::install_github('guslipkin/mistlecode')`.

 Also loading:  cipheR data.table dplyr purrr slider stringr tidyverse

dt <- readLines("input.txt")

dt <- 
  data.frame(dt) |>
  mutate(monkey = cumsum(grepl("Monkey \\d+:", dt)) - 1) |>
  filter(dt != "")

Oh no. I’m going to bed.

Part 1

This was so much fun! I dipped my toes into S3 classes, made a useful function factory, and did some recursion. I had a bit of trouble making sure my list of monkeys was getting passed around properly and returned because loops can’t change objects in the global environment. That said, I have a bad feeling about part 2.

operation <- function(op, val) {
  function(old) {
    if (val == "old") { val <- as.integer(old) } 
    else { val <- as.integer(val) }
    
    if (op == "*") { val <- old * val }
    else if (op == "+") { val <- old + val }
    
    return(val)
  }
}

new_monkey <- function(dt, x) {
  name <- str_extract(dt[1,"dt"], "\\d+")
  items <- 
    str_split(dt[2,"dt"], ":|,", simplify = TRUE)[1,-1] |> as.numeric()
  opp <- 
    str_split(dt[3, "dt"], "=", simplify = TRUE)[1,2] |>
    str_match(" (new|old) (\\+|\\-|\\*|\\/) (old|\\d+)")
  op_op <- opp[1,3]
  op_num <- ifelse(opp[1,4])
  op <- operation(op = opp[1,3], val = opp[1,4])
  test <- str_extract(dt[4,"dt"], "\\d+") |> as.integer()
  case_true <- str_extract(dt[5,"dt"], "\\d+")
  case_false <- str_extract(dt[6,"dt"], "\\d+")
  x <- list(
    "name" = name,
    "items" = items,
    "operation" = op,
    "test" = test,
    "case_true" = case_true,
    "case_false" = case_false,
    "inspections" = 0
  )
  structure(x, class = "monkey")
}

monkeys <- 
  lapply(unique(dt$monkey), \(m) { 
    new_monkey(dt[dt$monkey == m,], m) 
  })
names(monkeys) <- sapply(monkeys, \(m) m$name)

process_items <- function(item, monkey, these_monkeys) {
  if (is.na(monkey$items[item]) | 
      item > length(monkey$items)) { return(these_monkeys) }
  worry_level <- monkey$operation(monkey$items[item])
  worry_level <- floor(worry_level / 3)
  if (worry_level %% monkey$test == 0) {
    case_true <- 
      c(these_monkeys[[monkey$case_true]]$items, worry_level)
    these_monkeys[[monkey$case_true]]$items <- 
      case_true[!is.na(case_true)]
  } else {
    case_false <- 
      c(these_monkeys[[monkey$case_false]]$items, worry_level)
    these_monkeys[[monkey$case_false]]$items <- 
      case_false[!is.na(case_false)]
  }
  process_items(item + 1, monkey, these_monkeys)
}

process_monkey <- function(i, these_monkeys) {
  if (i == length(monkeys) + 1) { return(these_monkeys) }
  monkey <- these_monkeys[[i]]
  these_monkeys <- process_items(1, monkey, these_monkeys)
  monkey$inspections <- 
    sum(monkey$inspections, length(monkey$items), na.rm = TRUE)
  monkey$items <- as.numeric(NA)
  these_monkeys[[i]] <- monkey
  process_monkey(i + 1, these_monkeys)
}

round <- function(these_monkeys, round) {
  if (round == round_max + 1) { return(these_monkeys) }
  these_monkeys <- process_monkey(1, these_monkeys)
  round(these_monkeys, round + 1)
}

round_max <- 20
m <- round(monkeys, 1)
sapply(m, \(m) m$inspections) |>
  sort(decreasing = TRUE) |>
  head(2) |>
  prod()

[1] 316888

Part 2

I want to scream. I submitted my answer just to see and it’s right, even though the test input was wrong. I could’ve submitted yesterday 😭 So many hours devoted to these monkeys for nothing…

I figured out the worry_level %% prod(tests) thing pretty quick after part 1, but it took a full day because the test input never lined up, even if I got super close. I still want to figure out why that is, but for now I’m just happy to have the star.

process_items <- function(item, monkey, these_monkeys) {
  if (is.na(monkey$items[item]) | 
      item > length(monkey$items)) { return(these_monkeys) }
  worry_level <- monkey$operation(monkey$items[item])
  case <- (worry_level %% monkey$test) == 0
  worry_level <- worry_level %% prod(tests)
  if (case) {
    case_true <- 
      c(these_monkeys[[monkey$case_true]]$items, worry_level)
    these_monkeys[[monkey$case_true]]$items <- 
      case_true[!is.na(case_true)]
  } else {
    case_false <- 
      c(these_monkeys[[monkey$case_false]]$items, worry_level)
    these_monkeys[[monkey$case_false]]$items <- 
      case_false[!is.na(case_false)]
  }
  process_items(item + 1, monkey, these_monkeys)
}

m <- monkeys
tests <- sapply(m, \(m) m$test)

round_max <- 1
i <- 1
while (i <= 10000) {
  m <- process_monkey(1, m)
  i <- i + 1
}

sapply(m, \(m) m$inspections) |>
  sort(decreasing = TRUE) |>
  head(2) |>
  prod()

[1] 35270398814