My solution to Day 18 of Advent of Code 2021

advent-2021-day-18.R

library(tidyverse)
library(adventdrob)

# Add a value to the leftmost position in a binary tree
add_leftmost <- function(x, value) {
  if (!is.list(x)) x + value
  else list(add_leftmost(x[[1]], value), x[[2]])
}

# Add a value to the rightmost position in a binary tree
add_rightmost <- function(x, value) {
  if (!is.list(x)) x + value
  else list(x[[1]], add_rightmost(x[[2]], value))
}

# Take the leftmost pair and "explode" it
explode_leftmost <- function(x, depth = 0) {
  if (!is.list(x)) {
    return(list(result = x, left = NULL, right = NULL, has_exploded = FALSE))
  }

  if (depth >= 4 && is.numeric(x[[1]]) && is.numeric(x[[2]])) {
    # Explode
    return(list(result = 0,
                left = x[[1]],
                right = x[[2]],
                has_exploded = TRUE))
  }

  left <- explode_leftmost(x[[1]], depth = depth + 1)
  
  if (!is.null(left$right)) {
    # left "owes" an exploded number to the right
    right_result <- add_leftmost(x[[2]], left$right)
    right <- list(result = right_result, left = NULL, right = NULL, has_exploded = FALSE)
    left$right <- NULL
  } else if (left$has_exploded) {
    # Right side is good as it is
    right <- list(result = x[[2]], left = NULL, right = NULL, has_exploded = FALSE)
  } else {
    # Right side needs to explode
    right <- explode_leftmost(x[[2]], depth = depth + 1)
    if (!is.null(right$left)) {
      left$result <- add_rightmost(left$result, right$left)
      right$left <- NULL
    }
  }

  list(result = list(left$result, right$result),
       left = left$left,
       right = right$right,
       has_exploded = left$has_exploded || right$has_exploded)
}

# Take the leftmost number >= 10 and split it into a pair
split_leftmost <- function(x) {
  if (!is.list(x)) {
    if (x >= 10) {
      return(list(result = list(floor(x / 2), ceiling(x / 2)),
                  has_split = TRUE))
    } else {
      return(list(result = x,
                  has_split = FALSE))
    }
  }

  left <- split_leftmost(x[[1]])
  if (left$has_split) {
    # Don't need any further splitting
    return(list(result = list(left$result, x[[2]]),
                has_split = TRUE))
  } else {
    right <- split_leftmost(x[[2]])
    return(list(result = list(left$result, right$result),
                has_split = left$has_split || right$has_split))
  }
}

# Apply the explode + split rules repeatedly until it reaches a reduced form
reduce_snailfish <- function(x) {
  # The output of each function is wrapped in a list, so start it that way
  x <- list(result = x)
  while (TRUE) {
    x <- explode_leftmost(x$result)
    if (!x$has_exploded) {
      x <- split_leftmost(x$result)
      if (!x$has_split) {
        return(x$result)
      }
    }
  }
}

# Combine two expressions and reduce them
add_and_reduce <- function(x1, x2) {
  reduce_snailfish(list(x1, x2))
}

magnitude <- function(x) {
  if (!is.list(x)) {
    x
  } else {
    3 * magnitude(x[[1]]) + 2 * magnitude(x[[2]])
  }
}

# Now we get to the solution

# Parse a [] string into a nested list
parse_pairs <- function(x) {
  x %>%
    str_replace_all("\\[", "list(") %>%
    str_replace_all("\\]", ")") %>%
    parse(text = .) %>%
    eval()
}

parsed <- advent_input(18, 2021) %>%
  mutate(expr = map(x, parse_pairs))

# Part 1
parsed$expr %>%
  reduce(add_and_reduce) %>%
  magnitude()

# Part 2
parsed %>%
  crossing(parsed %>% select(-x) %>% rename(expr2 = expr)) %>%
  mutate(combined = map2(expr, expr2, add_and_reduce),
         magnitude = map_dbl(combined, magnitude)) %>%
  summarize(max(magnitude))