# Advent of Code 2020 - Day 24

By Eric Burden | December 25, 2020

In the spirit of the holidays (and programming), I’ll be posting my solutions to the Advent of Code 2020 puzzles here, at least one day after they’re posted (no spoilers!). I’ll be implementing the solutions in R because, well, that’s what I like! What I won’t be doing is posting any of the actual answers, just the reasoning behind them.

Also, as a general convention, whenever the puzzle has downloadable input, I’m saving it in a file named input.txt.

# Day 24 - Lobby Layout

Find the problem description HERE.

## Part One - Mystery Mosaic

For this puzzle, we’ve got two different approaches with varying degrees of speedy operation. After Day 23, I felt somewhat compelled to try optimizing the solution to this puzzle, then gave up when I realized how much code I’d already written after getting the right answer. Good beats perfect every time!

### The Array Approach

Based on the excellent advice in this primer on hexagonal grids, we’ve got a ‘slice’ of a three-dimensional array for tracking our tiles. It’s not terribly space-efficient, since most of the array is left ‘empty’, but it’s fairly straightforward to reason about.

# Setup ------------------------------------------------------------------------

test_input <- c(
"sesenwnenenewseeswwswswwnenewsewsw",
"neeenesenwnwwswnenewnwwsewnenwseswesw",
"seswneswswsenwwnwse",
"nwnwneseeswswnenewneswwnewseswneseene",
"swweswneswnenwsewnwneneseenw",
"eesenwseswswnenwswnwnwsewwnwsene",
"sewnenenenesenwsewnenwwwse",
"wenwwweseeeweswwwnwwe",
"wsweesenenewnwwnwsenewsenwwsesesenwne",
"neeswseenwwswnwswswnw",
"nenwswwsewswnenenewsenwsenwnesesenew",
"enewnwewneswsewnwswenweswnenwsenwsw",
"sweneswneswneneenwnewenewwneswswnese",
"swwesenesewenwneswnwwneseswwne",
"enesenwswwswneneswsenwnewswseenwsese",
"wnwnesenesenenwwnenwsewesewsesesew",
"nenewswnwewswnenesenwnesewesw",
"eneswnwswnwsenenwnwnwwseeswneewsenese",
"neswnwewnwnwseenwseesewsenwsweewe",
"wseweeenwnesenwwwswnew"
)
real_input <- readLines('input.txt')

# Mapping of compass directions to offsets in three-dimensional space
dir_map <- list(
nw = c( 0,  1, -1),
ne = c( 1,  0, -1),
e =  c( 1, -1,  0),
se = c( 0, -1,  1),
sw = c(-1,  0,  1),
w  = c(-1,  1,  0)
)

# Functions --------------------------------------------------------------------

# Given a vector of strings where each string represents a direction to move
# from the center dirs and a mapping of individual direction strings to
# three-dimensional coordinate offsets dir_map, return the final offset
# in three-dimensional coordinates indicated by the directions.
parse_directions <- function(dirs, dir_map) {
final_location <- c(0, 0, 0)
for (dir in dirs) { final_location <- final_location + dir_map[[dir]] }
final_location
}

# Given a vector of strings from the puzzle input input and a mapping of
# individual compass directions to three-dimensional coordinate offsets
# dir_map, return a list of three-dimensional offsets resulting from following
# the set of directions in each element of input
parse_input <- function(input, dir_map) {
tokens <- regmatches(input, gregexpr('(e|w|[ns][ew])', input))
lapply(tokens, parse_directions, dir_map)
}

# Given a the maximum distance from a central point of any individual tile
# offset max_offset, return a three-dimensional array large enough to
# encompass the entire 'floor', where each array element is either NA or 0.
# A 0 represents the location of a white tile in the floor, an NA represents
# a space in the matrix that is not a part of the floor. These NA's are
# essentially ignored.
init_tile_map <- function(max_offset) {
offset_range <- c(-max_offset:max_offset)     # The maximum range of offsets
map_dim <- (max_offset * 2) + 1               # The dimensions of the array
tile_map <- array(NA, dim = rep(map_dim, 3))  # Empty array of sufficient size
center <- rep(ceiling(map_dim / 2), 3)        # The center point of the array

# Only the array indices that sum to the same value as the central index
# would be included in the diagonal slice of the array representing the
# floor. Those tiles start off as white (0)
all_coords <- arrayInd(1:map_dim^3, rep(map_dim, 3))
tile_coords <- all_coords[rowSums(all_coords) == sum(center),]
tile_map[tile_coords] <- 0

tile_map  # Return the tile_map
}

# Given an offset from the tile_map's central point relative_tile_loc and
# a three-dimensional array containing the locations of tiles in the floor
# tile_map, 'flips' the tile indicated by relative_tile_loc, i.e. toggles
# the array index value between 1 and 0
flip_tile <- function(relative_tile_loc, tile_map) {
center <- ceiling(dim(tile_map) / 2)  # Array central point
ti <- center + relative_tile_loc      # Absolute array index of the tile

# 'Flip' the tile (toggle the value)
tile_map[ti, ti, ti] <- abs(1 - tile_map[ti, ti, ti])

tile_map  # Return the modified matrix
}

# Processing -------------------------------------------------------------------

relative_tile_locs <- parse_input(real_input, dir_map)  # Parse the input directions
max_offset <- max(abs(unlist(relative_tile_locs)))      # Max tile offset in any direction
tile_map <- init_tile_map(max_offset)                   # Initialize the tile map array

# For each tile that needs to be flipped, flip it!
for (loc in relative_tile_locs) { tile_map <- flip_tile(loc, tile_map) }

answer1 <- sum(tile_map, na.rm = T)  # Sum of all tile values, black tiles = 1


### The Data Frame Approach

To improve upon the seemingly egregious wasted ‘space’ of the array, let’s test out a solution using a data frame as the data structure and only storing the coordinates that actually held tiles.

# Setup ------------------------------------------------------------------------

test_input <- c(
"sesenwnenenewseeswwswswwnenewsewsw",
"neeenesenwnwwswnenewnwwsewnenwseswesw",
"seswneswswsenwwnwse",
"nwnwneseeswswnenewneswwnewseswneseene",
"swweswneswnenwsewnwneneseenw",
"eesenwseswswnenwswnwnwsewwnwsene",
"sewnenenenesenwsewnenwwwse",
"wenwwweseeeweswwwnwwe",
"wsweesenenewnwwnwsenewsenwwsesesenwne",
"neeswseenwwswnwswswnw",
"nenwswwsewswnenenewsenwsenwnesesenew",
"enewnwewneswsewnwswenweswnenwsenwsw",
"sweneswneswneneenwnewenewwneswswnese",
"swwesenesewenwneswnwwneseswwne",
"enesenwswwswneneswsenwnewswseenwsese",
"wnwnesenesenenwwnenwsewesewsesesew",
"nenewswnwewswnenesenwnesewesw",
"eneswnwswnwsenenwnwnwwseeswneewsenese",
"neswnwewnwnwseenwseesewsenwsweewe",
"wseweeenwnesenwwwswnew"
)
real_input <- readLines('input.txt')

# Mapping of compass directions to offsets in three-dimensional space
dir_map <- list(
nw = c( 0,  1, -1),
ne = c( 1,  0, -1),
e =  c( 1, -1,  0),
se = c( 0, -1,  1),
sw = c(-1,  0,  1),
w  = c(-1,  1,  0)
)

# Functions --------------------------------------------------------------------

# Given a vector of strings where each string represents a direction to move
# from the center dirs and a mapping of individual direction strings to
# three-dimensional coordinate offsets dir_map, return the final offset
# in three-dimensional coordinates indicated by the directions.
parse_directions <- function(dirs, dir_map) {
final_location <- c(0, 0, 0)
for (dir in dirs) { final_location <- final_location + dir_map[[dir]] }
final_location
}

# Given a vector of strings from the puzzle input input and a mapping of
# individual compass directions to three-dimensional coordinate offsets
# dir_map, return a list of three-dimensional offsets resulting from following
# the set of directions in each element of input
parse_input <- function(input, dir_map) {
tokens <- regmatches(input, gregexpr('(e|w|[ns][ew])', input))
lapply(tokens, parse_directions, dir_map)
}

# Given a the maximum distance from a central point of any individual tile
# offset max_offset, returns a data frame containing columns for x, y,
# z, and color, where each row in the data frame represents an individual
# tile with coordinates.
build_tile_table <- function(max_offset) {
offset_range <- c(-(max_offset):(max_offset))   # The maximum range of offsets

# Create a data frame containing all combinations of the values in the
# offset_range, then filter out any rows where the coordinates do not
# sum to zero
all_coords <- expand.grid(x = offset_range, y = offset_range, z = offset_range)
tile_coords <- all_coords[rowSums(all_coords) == 0,]

# Return a data frame containing all the remaining coordinates and 'white'
# for the color
data.frame(
x = tile_coords$x, y = tile_coords$y, z = tile_coords$z, color = 'white', stringsAsFactors = FALSE ) } # Given an index relative to the central tile relative_tile_loc and a data # frame of tile locations, 'flip' the color of the tile on the row indicated # by relative_tile_loc flip_tile <- function(relative_tile_loc, tile_table) { selector <- ( tile_table$x == relative_tile_loc &
tile_table$y == relative_tile_loc & tile_table$z == relative_tile_loc
)
current_color <- tile_table[selector, 'color']
tile_table[selector, 'color'] <- ifelse(current_color == 'white', 'black', 'white')
tile_table
}

# Processing -------------------------------------------------------------------

relative_tile_locs <- parse_input(real_input, dir_map)  # Parse the input directions
max_offset <- max(abs(unlist(relative_tile_locs)))      # Max tile offset in any direction
tile_table <- build_tile_table(max_offset)              # Create a data frame of tiles

# For each set of directions, flip the indicated tile
for (loc in relative_tile_locs) { tile_table <- flip_tile(loc, tile_table) }
answer1 <- sum(tile_table$color == 'black') # Count the black tiles  That works! ## Part Two - Auld Lang Syne It’s the Game of Life again! ### The Array Approach This was where having the empty array elements felt the worst, since we end up iterating over all the spaces in the array, not just the tiles. There’s certainly a strategy out there to cut down on the unnecessary operations, but this approach works. One important observation was that increasing the size of the array by the minimum amount each time it was necessary was definitely faster than expanding the array by a larger amount but reducing the total number of expansions. # Setup ------------------------------------------------------------------------ source('exercise_1.R') # Function --------------------------------------------------------------------- # Given a index to a three-dimensional array i and a three-dimensional array # tile_map, returns the value at that index of the array. Provides safety # against referencing indices that aren't actually present in the array. get_tile_value <- function(i, tile_map) { # If the index is not in the array, val is NA val <- tryCatch( val <- tile_map[i, i, i], error = function(e) { NA_real_ } ) # Oddly, if any of the elements of i is 0, the index operator doesn't # throw an error but returns numeric(0), so we need to test for that. if (length(val) > 0) { val } else { NA_real_ } } # Given an index to a three-dimensional array tile_index and a # three-dimensional array tile_map, returns the number of black tiles # neighboring the element at index tile_index. get_neighbors <- function(tile_index, tile_map) { arr_index <- arrayInd(tile_index, dim(tile_map)) neighbor_offsets <- list( c(0, 1, -1), c( 1, 0, -1), c( 1, -1, 0), c(0, -1, 1), c(-1, 0, 1), c(-1, 1, 0) ) neighbor_indices <- lapply(neighbor_offsets, +, arr_index) neighbor_values <- vapply(neighbor_indices, get_tile_value, numeric(1), tile_map) sum(neighbor_values, na.rm = T) } # Given a 3D array tile_map, returns the elements (in a 1D vector) on the # outer edges of the array. get_shell <- function(tile_map) { d <- dim(tile_map) d1_edge_cells <- tile_map[c(1, d), , ] d2_edge_cells <- tile_map[ , c(1, d), ] d3_edge_cells <- tile_map[ , , c(1, d)] c(d1_edge_cells, d2_edge_cells, d3_edge_cells) } # Given an index to a 3D array tile_index and a 3D array tile_map, return # the state of the element at index tile_index after applying the rules # for changing element state in the puzzle description. next_tile_state <- function(tile_index, tile_map) { tile_value <- tile_map[tile_index] if (is.na(tile_value)) { return(NA_real_) } neighbors_value <- get_neighbors(tile_index, tile_map) if (tile_value == 1 && (neighbors_value == 0 | neighbors_value > 2)) { 0 } else if (tile_value == 0 && neighbors_value == 2) { 1 } else { tile_value } } # Given a 3D array tile_map and the number of 'layers' to expand the array by # expand_by, add expand_by additional layers to the outside of the array # and return it. expand_tile_map <- function(tile_map, expand_by = 1) { old_dims <- dim(tile_map) new_dims <- old_dims + (2 * expand_by) new_center <- ceiling(new_dims / 2) new_map <- array(dim = new_dims) all_coords <- arrayInd(1:prod(new_dims), new_dims) tile_coords <- all_coords[rowSums(all_coords) == sum(new_center),] new_map[tile_coords] <- 0 r1 <- new_center - floor(old_dims / 2) r2 <- new_center + floor(old_dims / 2) new_map[r1:r2, r1:r2, r1:r2] <- tile_map new_map } # Processing ------------------------------------------------------------------- # Advance the floor state 100 times, starting with the floor state at the end # of part one. rounds <- 100 pb <- txtProgressBar(max = rounds, style = 3) for (i in 1:rounds) { # If there are any black tiles on the outer edge of the tile_map, then we # 'may' need to flip tiles that don't exist yet, so we go ahead and add an # extra layer of white tiles to the outside. if (any(get_shell(tile_map) == 1, na.rm = T)) { tile_map <- expand_tile_map(tile_map) } # Advance the floor state by iterating over the tile_map and calculating # the next state for each element tile_map <- apply( slice.index(tile_map, c(1, 2, 3)), c(1, 2, 3), next_tile_state, tile_map ) setTxtProgressBar(pb, i) } close(pb) answer2 <- sum(tile_map, na.rm = T) # Sum the number of black tiles  ### The Data Frame Approach So, the whole reason for the data frame attempt was the idea that it might be faster if we weren’t iterating through a bunch of empty array elements each time. # Setup ------------------------------------------------------------------------ source('exercise_1b.R') # Functions -------------------------------------------------------------------- # Given a vector indicating the x/y/z coordinates of a tile tile_loc and a # data frame of tile locations and colors tile_table, return the color of # the tile on the row indicated by tile_loc get_tile_color <- function(tile_loc, tile_table) { selector <- ( tile_table$x == tile_loc &
tile_table$y == tile_loc & tile_table$z == tile_loc
)
tile_table[selector, 'color']
}

# Given a vector indicating the x/y/z coordinates of a tile tile_loc and a
# data frame of tile locations and colors tile_table, returns a list of
# coordinates for neighboring tiles
get_neighbors <- function(tile_loc, tile_table) {
neighbor_offsets <- list(
c(0,  1, -1), c( 1, 0, -1), c( 1, -1, 0),
c(0, -1,  1), c(-1, 0,  1), c(-1,  1, 0)
)
lapply(neighbor_offsets, +, tile_loc)
}

# Given a vector indicating the x/y/z coordinates of a tile tile_loc and a
# data frame of tile locations and colors tile_table, return a vector of the
# colors of the neighboring tiles
get_neighbor_colors <- function(tile_loc, tile_table) {
neighbor_indices <- get_neighbors(tile_loc, tile_table)
neighbor_colors <- sapply(neighbor_indices, get_tile_color, tile_table)
neighbor_colors
}

# Given a vector indicating the x/y/z coordinates of a tile tile_loc and a
# data frame of tile locations and colors tile_table, return the next color
# of the indicated tile according to the rules of the puzzle
next_tile_color <- function(tile_loc, tile_table) {
tile_color <- get_tile_color(tile_loc, tile_table)  # Current tile color

# Colors of the neighboring tiles
neighbor_colors <- get_neighbor_colors(tile_loc, tile_table)
black_neighbors <- sum(neighbor_colors == 'black', na.rm = T)  # Count black neighbors

# Should the tile be flipped?
flip <- if (tile_color == 'black') {
black_neighbors == 0 | black_neighbors > 2
} else if (tile_color == 'white') {
black_neighbors == 2
} else {
stop(paste('Could not get a color for tile: ', tile_loc))
}

# The final tile color
if (flip & tile_color == 'white') {
'black'
} else if (flip & tile_color == 'black') {
'white'
} else {
tile_color
}
}

# Given a vector indicating the x/y/z coordinates of a tile tile_loc and a
# data frame of tile locations and colors tile_table, add rows to the
# tile_table to ensure that the tile_table contains records for all the
# tiles neighboring tile_loc
add_neighbors <- function(tile_loc, tile_table) {
neighbor_indices <- get_neighbors(tile_loc, tile_table)  # Locations of neighbors

# For each neighbor index...
for (ni in neighbor_indices) {

# Define a selector for the row at the index
ni <- as.numeric(ni)
selector <- (
tile_table$x == ni & tile_table$y == ni &
tile_table$z == ni ) # If there's no row at that index, add one if (nrow(tile_table[selector,]) < 1) { new_row <- data.frame( x = ni, y = ni, z = ni, color = 'white', all_neighbors = FALSE, stringsAsFactors = F ) tile_table <- rbind(tile_table, new_row) } } # Indicate in the 'all_neighbors' column that all the neighbors for this # tile are represented in the table tile_table[ tile_table$x == tile_loc &
tile_table$y == tile_loc & tile_table$z == tile_loc,
'all_neighbors'
] <- TRUE

tile_table  # Return the tile_table
}

# Given a data frame of tile locations and colors tile_table, iterate through
# the black tiles and ensure those tiles all have their neighbors represented
# in the table
expand_table <- function(tile_table) {

# Select the coordinates from all the tile_table rows representing black
# tiles where we haven't yet confirmed all the neighbors for that  tile are
# in the tile_table
black_tile_locs <- tile_table[
(tile_table$color == 'black' & !tile_table$all_neighbors),
c('x', 'y', 'z')
]
num_black_tiles <- nrow(black_tile_locs)  # The number of tiles to check

# For each black tile to be checked...
for (btl in split(black_tile_locs, 1:num_black_tiles)) {
tile_table <- add_neighbors(btl, tile_table)  # Add all its neighbors
}
tile_table  # Return the tile_table
}

# Given a data frame of tile locations and colors tile_table, return the
# colors for each row in the data frame representing the next state of each
# tile according to the instructions
next_table_colors <- function(tile_table) {
apply(tile_table[,c('x', 'y', 'z')], 1, next_tile_color, tile_table)
}

# Processing -------------------------------------------------------------------

tile_table\$all_neighbors <- FALSE  # Set the all_neighbors column to FALSE

# Advance the floor state 100 times, starting with the floor state at the end
# of part one.
rounds <- 100
pb <- txtProgressBar(min = 0, max = rounds, style = 3)
for (i in 1:rounds) {
tile_table <- expand_table(tile_table)       # Ensure all black tiles have neighbors
new_colors <- next_table_colors(tile_table)  # Determine new tile colors
tile_table[, 'color'] <- new_colors          # Set new tile colors
setTxtProgressBar(pb, i)
}
close(pb)

answer2 <- sum(tile_table[,'color'] == 'black')  # Count the black tiles


So, was it faster? Well…

Run Time:

Array Approach                Data Frame Approach
user  system elapsed            user  system elapsed
330.447   0.378 331.982         817.908   0.251 816.945


Nope.

## Wrap-Up

I feel like I probably spent way too much time on this one and still didn’t get the sort of performance I’d like, but I did learn some important lessons about the relative performance of lookups in arrays versus data frames. I’m pretty sure a big part of it was identifying rows in the data frame by their values instead of their position, but I couldn’t work out a good system to identify coordinates by index without including a bunch of empty rows. I don’t mind leaving this one with some room for improvement, but I suspect I’ll come back to this problem when I have some free time and think about it some more. Which, really, to me is the mark of a truly excellent puzzle!

If you found a different solution (or spotted a mistake in one of mine), please drop me a line!

comments powered by Disqus