My solution to Day 19 of Advent of Code 2021

advent-2021-day-19.R

library(tidyverse)
library(adventdrob)

input <- advent_input(19, 2021)

beacons <- input %>%
  filter(x != "") %>%
  mutate(scanner = cumsum(str_detect(x, "scanner"))) %>%
  filter(!str_detect(x, "scanner")) %>%
  separate(x, c("x", "y", "z"), sep = ",", convert = TRUE) %>%
  group_by(scanner) %>%
  mutate(b = row_number())

# Get all beacon-beacon distances *within* each scanner
distances <- beacons %>%
  inner_join(beacons, by = "scanner", suffix = c("1", "2")) %>%
  filter(b1 != b2) %>%
  mutate(distance = sqrt((x2 - x1) ^ 2 + (y2 - y1) ^ 2 + (z2 - z1) ^ 2)) %>%
  select(scanner, b1, b2, distance)

# Another self-join to compare two scanners (s1 and s2)
# Whichever beacon in s2 has the most distances in common
pairs <- distances %>%
  inner_join(distances, by = "distance", suffix = c("_s1", "_s2")) %>%
  filter(scanner_s1 != scanner_s2) %>%
  gather(b, beacon_s2, b1_s2, b2_s2) %>%
  count(scanner_s1, scanner_s2, beacon_s1 = b1_s1, beacon_s2, sort = TRUE) %>%
  distinct(scanner_s1, scanner_s2, beacon_s1, .keep_all = TRUE) %>%
  filter(scanner_s1 < scanner_s2) %>%
  group_by(scanner_s1, scanner_s2) %>%
  filter(n() >= 12) %>%
  ungroup()

# Create pairs of 12x3 matrices for each pair of overlapping scanners
matrices <- beacons %>%
  group_by(scanner) %>%
  summarize(matrix = list(cbind(x, y, z)))

matching_matrices <- pairs %>%
  group_by(scanner_s1, scanner_s2) %>%
  summarize(index_s1 = list(beacon_s1),
            index_s2 = list(beacon_s2)) %>%
  ungroup() %>%
  inner_join(matrices %>% select(scanner, matrix1 = matrix),
             by = c("scanner_s1" = "scanner")) %>%
  inner_join(matrices %>% select(scanner, matrix2 = matrix),
             by = c("scanner_s2" = "scanner")) %>%
  mutate(matrix1 = map2(matrix1, index_s1, ~ .x[.y, ]),
         matrix2 = map2(matrix2, index_s2, ~ .x[.y, ]))

# Get the transformations needed to turn matrix 1 to match matrix 2
transformation_find <- function(m1, m2) {
  # Match standard deviations to find how x, y, z line up
  m1_sds <- round(apply(m1, 2, sd))
  m2_sds <- round(apply(m2, 2, sd))

  # Reorient m2's xyz to match m1
  reorderer <- match(m2_sds, m1_sds)
  m1 <- m1[, reorderer]

  # Reorient the direction
  facing <- (m2[2, ] - m2[1, ]) / (m1[2, ] - m1[1, ])
  m1 <- t(facing * t(m1))

  # Find the difference
  delta <- (m2 - m1)[1, ]
  list(reorderer = reorderer,
       facing = facing,
       delta = delta)
}

transformation_apply <- function(m, tr) {
  ret <- t(tr$facing * t(m[, tr$reorderer]) + tr$delta)
  colnames(ret) <- c("x", "y", "z")
  ret
}

# Transformations from 1->2 and back
matrix_transformations <- matching_matrices %>%
  transmute(s1 = scanner_s1,
            s2 = scanner_s2,
            transformation = map2(matrix1, matrix2, transformation_find))

reverse_transformations <- matching_matrices %>%
  transmute(s1 = scanner_s2,
            s2 = scanner_s1,
            transformation = map2(matrix2, matrix1, transformation_find))

transformations <- bind_rows(matrix_transformations, reverse_transformations)

library(tidygraph)
library(igraph)

# Sort to ensure index x is scanner x
g <- graph_from_data_frame(transformations) %>%
  as_tbl_graph() %>%
  arrange(as.integer(name))

# For each matrix, apply the series of transformations
results <- map(seq_len(nrow(matrices)), function(i) {
  edges <- as.numeric(igraph::shortest_paths(g, i, 1, output = "epath")$epath[[1]])
  
  transforms <- transformations$transformation[edges]
  
  # For part 2 (not shown), I threw in a 0,0,0 point for each
  reduce(transforms, transformation_apply, .init = matrices$matrix[[i]])
})

# Find the number of distinct x/y/z
results %>%
  enframe() %>%
  mutate(value = map(value, as.data.frame)) %>%
  unnest(value) %>%
  distinct(x, y, z)