1 Setup
1.1 Libraries
library(httr)
library(xml2)
library(magrittr)
library(tibble)
library(dplyr)
library(tidyr)
library(purrr)
library(stringr)
library(R6)1.2 Retrieve Data from AoC
session_cookie <- set_cookies(session = keyring::key_get("AoC-GitHub-Cookie"))
base_url <- paste0("https://adventofcode.com/2021/day/", params$task_nr)
puzzle <- GET(base_url,
session_cookie) %>%
content(encoding = "UTF-8") %>%
xml_find_all("///article") %>%
lapply(as.character)
puzzle_data <- GET(paste0(base_url, "/input"),
session_cookie) %>%
content(encoding = "UTF-8") %>%
str_split("\n") %>%
`[[`(1L) %>%
Filter(nzchar, .) %>%
str_extract_all("on|off|-?\\d+") %>%
do.call(rbind, .) %>%
`colnames<-`(c("switch", "x0", "x1", "y0", "y1", "z0", "z1")) %>%
as_tibble() %>%
mutate(across(x0:z1, as.integer))2 Puzzle Day 22
2.1 Part 1
2.1.1 Description
— Day 22: Reactor Reboot —
Operating at these extreme ocean depths has overloaded the submarine’s reactor; it needs to be rebooted.
The reactor core is made up of a large 3-dimensional grid made up entirely of cubes, one cube per integer 3-dimensional coordinate (x,y,z). Each cube can be either on or off; at the start of the reboot process, they are all off. (Could it be an old model of a reactor you’ve seen before?)
To reboot the reactor, you just need to set all of the cubes to either on or off by following a list of reboot steps (your puzzle input). Each step specifies a cuboid (the set of all cubes that have coordinates which fall within ranges for x, y, and z) and whether to turn all of the cubes in that cuboid on or off.
For example, given these reboot steps:
on x=10..12,y=10..12,z=10..12
on x=11..13,y=11..13,z=11..13
off x=9..11,y=9..11,z=9..11
on x=10..10,y=10..10,z=10..10
The first step (on x=10..12,y=10..12,z=10..12) turns on a 3x3x3 cuboid consisting of 27 cubes:
-
10,10,10 -
10,10,11 -
10,10,12 -
10,11,10 -
10,11,11 -
10,11,12 -
10,12,10 -
10,12,11 -
10,12,12 -
11,10,10 -
11,10,11 -
11,10,12 -
11,11,10 -
11,11,11 -
11,11,12 -
11,12,10 -
11,12,11 -
11,12,12 -
12,10,10 -
12,10,11 -
12,10,12 -
12,11,10 -
12,11,11 -
12,11,12 -
12,12,10 -
12,12,11 -
12,12,12
The second step (on x=11..13,y=11..13,z=11..13) turns on a 3x3x3 cuboid that overlaps with the first. As a result, only 19 additional cubes turn on; the rest are already on from the previous step:
-
11,11,13 -
11,12,13 -
11,13,11 -
11,13,12 -
11,13,13 -
12,11,13 -
12,12,13 -
12,13,11 -
12,13,12 -
12,13,13 -
13,11,11 -
13,11,12 -
13,11,13 -
13,12,11 -
13,12,12 -
13,12,13 -
13,13,11 -
13,13,12 -
13,13,13
The third step (off x=9..11,y=9..11,z=9..11) turns off a 3x3x3 cuboid that overlaps partially with some cubes that are on, ultimately turning off 8 cubes:
-
10,10,10 -
10,10,11 -
10,11,10 -
10,11,11 -
11,10,10 -
11,10,11 -
11,11,10 -
11,11,11
The final step (on x=10..10,y=10..10,z=10..10) turns on a single cube, 10,10,10. After this last step, 39 cubes are on.
The initialization procedure only uses cubes that have x, y, and z positions of at least -50 and at most 50. For now, ignore cubes outside this region.
Here is a larger example:
on x=-20..26,y=-36..17,z=-47..7
on x=-20..33,y=-21..23,z=-26..28
on x=-22..28,y=-29..23,z=-38..16
on x=-46..7,y=-6..46,z=-50..-1
on x=-49..1,y=-3..46,z=-24..28
on x=2..47,y=-22..22,z=-23..27
on x=-27..23,y=-28..26,z=-21..29
on x=-39..5,y=-6..47,z=-3..44
on x=-30..21,y=-8..43,z=-13..34
on x=-22..26,y=-27..20,z=-29..19
off x=-48..-32,y=26..41,z=-47..-37
on x=-12..35,y=6..50,z=-50..-2
off x=-48..-32,y=-32..-16,z=-15..-5
on x=-18..26,y=-33..15,z=-7..46
off x=-40..-22,y=-38..-28,z=23..41
on x=-16..35,y=-41..10,z=-47..6
off x=-32..-23,y=11..30,z=-14..3
on x=-49..-5,y=-3..45,z=-29..18
off x=18..30,y=-20..-8,z=-3..13
on x=-41..9,y=-7..43,z=-33..15
on x=-54112..-39298,y=-85059..-49293,z=-27449..7877
on x=967..23432,y=45373..81175,z=27513..53682
The last two steps are fully outside the initialization procedure area; all other steps are fully within it. After executing these steps in the initialization procedure region, 590784 cubes are on.
Execute the reboot steps. Afterward, considering only cubes in the region x=-50..50,y=-50..50,z=-50..50, how many cubes are on?
2.1.2 Solution
The first observation is that an intersection between 2 cubes is another cube, whose
dimensions are defined by the max and the min of the respective interval limits. For
instance the intersection between [1,4] x [2,5] x [3,6] and [0,1] x [1,3] x [4,5] is
determined by [max(1,0),min(4,1)] x [max(2,1),min(5,3)] x [max(3,4),min(6,5)] =
[1,1] x [2,3] x [4,5].
The second observation is that counting all blocks, which are switched on by a single cube corresponds to simply getting the volume of the cube.
The third observation leads us to the Inclusion-Exclusion Principle. That is, to get all blocks which are switched on, we have to sum up all volumes and add and remove the intersecting cubes according to the inclusion exclusion principle. That is, we have to maintain a list of all intersecting cubes and when we add (or remove, see next point) a new cube we simply have to intersect the new cube wiht all previous intersections.
The final observation is that substracting a cube differs from adding a cube only by the fact for the latter we add the cube itself as well, while for the former we simply intersect the deleting cube with all cubes already in the list.
This suggests the following algorithm:
- Add the first cube to the list
I. - Loop through all remaining cubes and for each new cube
I_jintersect it with all cubes and intersections already in the listIresulting inI'. - If we are adding, add the cube itself to
I'. - Keep a count of how many cubes took part in an intersections.
- Add the new intersections
I'toI. - Once done, sum the volumes of each intersection multiplied by
(-1)if there is an even number of cubes in the respective intersection.
To solve the puzzle eventually, all which is left to do is to remove the cubes which are outside the dedicated area.
solve <- function(data = puzzle_data, filter_inner = TRUE) {
volume <- function(x0, x1, y0, y1, z0, z1, ...) {
(x1 - x0 + 1) * (y1 - y0 + 1) * (z1 - z0 + 1)
}
intersect <- function(intersections, new_cube) {
left <- grep("0$", names(intersections), value = TRUE)
right <- grep("1$", names(intersections), value = TRUE)
right_cols <- map_dfc(right, ~ list(pmin(intersections[[.x]],
new_cube[[.x]])) %>%
set_names(.x))
left_cols <- map_dfc(left, ~ list(pmax(intersections[[.x]],
new_cube[[.x]])) %>%
set_names(.x))
res <- bind_cols(left_cols, right_cols)
res %>%
mutate(level = (intersections[["level"]] %||% -1) + 1) %>%
filter(x0 <= x1 & y0 <= y1 & z0 <= z1) %>%
mutate(volume = do.call(volume, .))
}
if (filter_inner) {
data <- data %>%
filter(x0 >= -50 & y0 >= -50 & z0 >= -50 &
x1 <= 50 & y1 <= 50 & z1 <= 50)
}
all_intersections <- data %>%
slice(1L) %>%
select(-switch) %>%
mutate(volume = do.call(volume, .),
level = 0L)
for (r_idx in seq(2L, nrow(data))) {
new_cube <- data %>%
slice(r_idx) %>%
mutate(volume = do.call(volume, .),
level = 0L)
new_intersections <- intersect(all_intersections, new_cube)
if (new_cube$switch == "on") {
new_intersections <- bind_rows(new_intersections, new_cube %>%
select(-switch))
}
all_intersections <- bind_rows(all_intersections, new_intersections)
}
all_intersections %>%
summarise(volume = sum((-1) ^ level * volume)) %>%
pull(volume) %>%
sprintf("%.0f", .)
}
solve()## [1] "524792"2.2 Part 2
2.2.1 Description
— Part Two —
Now that the initialization procedure is complete, you can reboot the reactor.
Starting with all cubes off, run all of the reboot steps for all cubes in the reactor.
Consider the following reboot steps:
on x=-5..47,y=-31..22,z=-19..33
on x=-44..5,y=-27..21,z=-14..35
on x=-49..-1,y=-11..42,z=-10..38
on x=-20..34,y=-40..6,z=-44..1
off x=26..39,y=40..50,z=-2..11
on x=-41..5,y=-41..6,z=-36..8
off x=-43..-33,y=-45..-28,z=7..25
on x=-33..15,y=-32..19,z=-34..11
off x=35..47,y=-46..-34,z=-11..5
on x=-14..36,y=-6..44,z=-16..29
on x=-57795..-6158,y=29564..72030,z=20435..90618
on x=36731..105352,y=-21140..28532,z=16094..90401
on x=30999..107136,y=-53464..15513,z=8553..71215
on x=13528..83982,y=-99403..-27377,z=-24141..23996
on x=-72682..-12347,y=18159..111354,z=7391..80950
on x=-1060..80757,y=-65301..-20884,z=-103788..-16709
on x=-83015..-9461,y=-72160..-8347,z=-81239..-26856
on x=-52752..22273,y=-49450..9096,z=54442..119054
on x=-29982..40483,y=-108474..-28371,z=-24328..38471
on x=-4958..62750,y=40422..118853,z=-7672..65583
on x=55694..108686,y=-43367..46958,z=-26781..48729
on x=-98497..-18186,y=-63569..3412,z=1232..88485
on x=-726..56291,y=-62629..13224,z=18033..85226
on x=-110886..-34664,y=-81338..-8658,z=8914..63723
on x=-55829..24974,y=-16897..54165,z=-121762..-28058
on x=-65152..-11147,y=22489..91432,z=-58782..1780
on x=-120100..-32970,y=-46592..27473,z=-11695..61039
on x=-18631..37533,y=-124565..-50804,z=-35667..28308
on x=-57817..18248,y=49321..117703,z=5745..55881
on x=14781..98692,y=-1341..70827,z=15753..70151
on x=-34419..55919,y=-19626..40991,z=39015..114138
on x=-60785..11593,y=-56135..2999,z=-95368..-26915
on x=-32178..58085,y=17647..101866,z=-91405..-8878
on x=-53655..12091,y=50097..105568,z=-75335..-4862
on x=-111166..-40997,y=-71714..2688,z=5609..50954
on x=-16602..70118,y=-98693..-44401,z=5197..76897
on x=16383..101554,y=4615..83635,z=-44907..18747
off x=-95822..-15171,y=-19987..48940,z=10804..104439
on x=-89813..-14614,y=16069..88491,z=-3297..45228
on x=41075..99376,y=-20427..49978,z=-52012..13762
on x=-21330..50085,y=-17944..62733,z=-112280..-30197
on x=-16478..35915,y=36008..118594,z=-7885..47086
off x=-98156..-27851,y=-49952..43171,z=-99005..-8456
off x=2032..69770,y=-71013..4824,z=7471..94418
on x=43670..120875,y=-42068..12382,z=-24787..38892
off x=37514..111226,y=-45862..25743,z=-16714..54663
off x=25699..97951,y=-30668..59918,z=-15349..69697
off x=-44271..17935,y=-9516..60759,z=49131..112598
on x=-61695..-5813,y=40978..94975,z=8655..80240
off x=-101086..-9439,y=-7088..67543,z=33935..83858
off x=18020..114017,y=-48931..32606,z=21474..89843
off x=-77139..10506,y=-89994..-18797,z=-80..59318
off x=8476..79288,y=-75520..11602,z=-96624..-24783
on x=-47488..-1262,y=24338..100707,z=16292..72967
off x=-84341..13987,y=2429..92914,z=-90671..-1318
off x=-37810..49457,y=-71013..-7894,z=-105357..-13188
off x=-27365..46395,y=31009..98017,z=15428..76570
off x=-70369..-16548,y=22648..78696,z=-1892..86821
on x=-53470..21291,y=-120233..-33476,z=-44150..38147
off x=-93533..-4276,y=-16170..68771,z=-104985..-24507
After running the above reboot steps, 2758514936282235 cubes are on. (Just for fun, 474140 of those are also in the initialization procedure region.)
Starting again with all cubes off, execute all reboot steps. Afterward, considering all cubes, how many cubes are on?
2.2.2 Solution
solve(filter_inner = FALSE)## [1] "1213461324555691"2.3 Original Solution
My original solution based on the same idea, but was utterly slow due to overengineered
S4 class and growing lists. I list it here for the sake of completeness, but the running
time suggests not to try it with the data set.
Cube <- setClass("Cube", slots = c(.x0 = "integer", .x1 = "integer",
.y0 = "integer", .y1 = "integer",
.z0 = "integer", .z1 = "integer"))
setGeneric("is_empty", function(object) {
standardGeneric("is_empty")
})
setGeneric("volume", function(object) {
standardGeneric("volume")
})
setValidity("Cube", function(object) {
all_slots <- c(outer(c(".x", ".y", ".z"), 0:1, paste0))
empty_slots <- all_slots %>%
map_lgl(~ length(slot(object, .x)) == 0L)
if (all(empty_slots)) {
TRUE
} else if (any(empty_slots)) {
## only some are empty but __not__ all
glue("slot `{all_slots[empty_slots]}` is empty but at least ",
"one other lsot is not empty")
} else {
## all slots are filled
OK <- c(object@.x1 >= object@.x0,
object@.y1 >= object@.y0,
object@.z1 >= object@.z0)
if (any(!OK)) {
faulty_slots <- c("x", "y", "z")[!OK]
start_points <- map_int(faulty_slots,
~ slot(object, paste0(".", .x, "0")))
end_points <- map_int(faulty_slots,
~ slot(object, paste0(".", .x, "1")))
glue("left interval limit `{faulty_slots}0` ",
"[{start_points}] is bigger than ",
"right interval limit `{faulty_slots}1` [{end_points}]")
} else {
TRUE
}
}
})
setMethod("initialize", "Cube",
function(.Object, x0 = NULL, x1 = NULL,
y0 = NULL, y1 = NULL,
z0 = NULL, z1 = NULL, ...) {
.Object <- callNextMethod(.Object, ...)
.Object@.x0 <- as.integer(x0)
.Object@.x1 <- as.integer(x1)
.Object@.y0 <- as.integer(y0)
.Object@.y1 <- as.integer(y1)
.Object@.z0 <- as.integer(z0)
.Object@.z1 <- as.integer(z1)
validObject(.Object)
.Object
})
setMethod("is_empty", "Cube",
function(object) {
## it suffices to test .x0 for zero length b/c the validator assures
## that either all are empty or none
length(object@.x0) == 0L
})
setMethod("volume", "Cube",
function(object) {
if (is_empty(object)) {
0L
} else {
(object@.x1 - object@.x0 + 1L) *
(object@.y1 - object@.y0 + 1L) *
(object@.z1 - object@.z0 + 1L)
}
})
setMethod("show", "Cube",
function(object) {
if (is_empty(object)) {
cat("<Empty Cube>\n")
} else {
cat(glue("[{object@.x0}, {object@.x1}] x ",
"[{object@.y0}, {object@.y1}] x ",
"[{object@.z0}, {object@.z1}]")
)
}
})
setMethod("-", c("Cube", "Cube"),
function(e1, e2) {
if (is_empty(e1) | is_empty(e2)) {
Cube()
} else {
x0 <- max(e1@.x0, e2@.x0)
x1 <- min(e1@.x1, e2@.x1)
y0 <- max(e1@.y0, e2@.y0)
y1 <- min(e1@.y1, e2@.y1)
z0 <- max(e1@.z0, e2@.z0)
z1 <- min(e1@.z1, e2@.z1)
if (x1 < x0 || y1 < y0 || z1 < z0) {
Cube()
} else {
Cube(x0, x1, y0, y1, z0, z1)
}
}
})
solve <- function(data = puzzle_data, filter_inner = TRUE, verbose = FALSE) {
cutter <- Cube(-50, 50, -50, 50, -50, 50)
pos <- neg <- vector("list", 32000)
pos_i <- neg_i <- 1
for (i in 1L:nrow(data)) {
row <- data[i, ]
new_cube <- do.call(Cube, as.list(row[-1L]))
if (verbose) {
cat("[", str_pad(as.character(i), 3), "/", nrow(data), "]: ", sep = "")
cat(if (row[1L] == "on") "Adding" else "Removing")
cat(" <")
show(new_cube)
cat(">...\n")
}
if (filter_inner) {
new_cube <- cutter - new_cube
}
if (!is_empty(new_cube)) {
subst <- map(pos[seq(1, length.out = pos_i - 1)],
~ .x - new_cube) %>%
Filter(Negate(is_empty), .)
add <- map(neg[seq(1, length.out = neg_i - 1)],
~ .x - new_cube) %>%
Filter(Negate(is_empty), .)
if (row[1L] == "on") {
add <- c(add, new_cube)
}
if (pos_i + length(add) > length(pos)) {
pos <- c(pos, vector("list", length(pos)))
}
if (neg_i + length(subst) > length(neg)) {
neg <- c(neg, vector("list", length(neg)))
}
pos[seq(pos_i, length.out = length(add))] <- add
neg[seq(neg_i, length.out = length(subst))] <- subst
pos_i <- pos_i + length(add)
neg_i <- neg_i + length(subst)
}
}
pos <- Filter(Negate(is.null), pos)
neg <- Filter(Negate(is.null), neg)
sum(map_int(pos, volume)) -
sum(map_int(neg, volume))
}