commit 01245326282a7fbddf6e850afce06049f266355c
parent bcbc8279488f62e0eea4b986d5d59b6b5947d4f5
Author: Eamon Caddigan <ec@eamoncaddigan.net>
Date: Tue, 9 Dec 2025 16:40:24 -0800
Solve day 09, part 2
Diffstat:
| M | src/day09.R | | | 181 | +++++++++++++++++++++++++++++++++++++++++++++++++++++++++---------------------- |
1 file changed, 131 insertions(+), 50 deletions(-)
diff --git a/src/day09.R b/src/day09.R
@@ -21,84 +21,165 @@ parse_input <- function(input_lines) {
(\(x) do.call(rbind, x))()
}
-point_lt <- function(p1, p2) {
- p1[2] < p2[2] || p1[2] == p2[2] && p1[1] < p1[1]
+tabulate_edges <- function(input_points) {
+ edge_info <- list(
+ tab = utils::hashtab("identical", nrow(input_points)),
+ ind = rep(NA_real_, nrow(input_points))
+ )
+ for (p1 in seq_len(nrow(input_points))) {
+ p2 <- (p1 %% nrow(input_points)) + 1
+ l_h <- input_points[p1, 2]
+ if (l_h == input_points[p2, 2]) {
+ edge_info$ind[length(edge_info$ind) + 1] <- l_h
+ utils::sethash(
+ edge_info$tab,
+ l_h,
+ c(
+ list(c(input_points[p1, 1], input_points[p2, 1])),
+ utils::gethash(edge_info$tab, l_h, list())
+ )
+ )
+ }
+ }
+ edge_info$ind <- unique(sort(edge_info$ind[!is.na(edge_info$ind)]))
+ edge_info
+}
+
+# Part 1 =====================================================================
+
+measure_rect <- function(p1, p2) {
+ (abs(p1[1] - p2[1]) + 1) * (abs(p1[2] - p2[2]) + 1)
}
-# Hacked together implementation of Graham Scan
-# Not worrying about efficient stack implementation; R's lists should suffice I
-# hope
-# Note: not robust to real-world input
-convex_hull <- function(points) {
- find_p0 <- function(points) {
- min_point_idx <- 1
- for (i in 2:nrow(points)) {
- if (point_lt(points[i, ], points[min_point_idx, ])) {
- min_point_idx <- i
+find_max_rect <- function(edge_info) {
+ max_rectangle <- NULL
+ for (sl in seq_along(edge_info$ind)) {
+ for (sl2 in sl:length(edge_info$ind)) {
+ for (p1 in range(unlist(edge_info$tab[[edge_info$ind[sl]]]))) {
+ for (p2 in range(unlist(edge_info$tab[[edge_info$ind[sl2]]]))) {
+ max_rectangle <- max(
+ max_rectangle,
+ measure_rect(
+ c(p1, edge_info$ind[sl]),
+ c(p2, edge_info$ind[sl2])
+ )
+ )
+ }
}
}
- min_point_idx
}
+ max_rectangle
+}
- right_turn <- function(p1, p2, p3) {
- (p2[1] - p1[1]) * (p3[2] - p1[2]) - (p2[2] - p1[2]) * (p3[1] - p1[1]) < 0
- }
+part1 <- function(input_lines) {
+ input_lines |>
+ parse_input() |>
+ tabulate_edges() |>
+ find_max_rect()
+}
+
+test_part1 <- function() {
+ stopifnot(part1(test_input) == 50)
+}
+
+# Part 2 =====================================================================
+
+edge_inside <- function(e1, e2) {
+ min(e2) < max(e1) && max(e2) > min(e1)
+}
- sort_points <- function(points) {
- p0 <- find_p0(points)
- slope <- (points[-p0, 1] - points[p0, 1]) / (points[-p0, 2] - points[p0, 2])
- rbind(
- points[p0, ],
- (points[-p0, ])[order(slope, decreasing = TRUE), ]
- )
+remove_edge <- function(e1, e2) {
+ if (max(e2) >= max(e1)) {
+ if (min(e2) <= min(e1)) {
+ NULL
+ } else {
+ list(c(min(e1), min(e2)))
+ }
+ } else if (min(e2) <= min(e1)) {
+ list(c(max(e2), max(e1)))
+ } else {
+ list(c(min(e1), min(e2)), c(max(e2), max(e1)))
}
+}
- points_sorted <- sort_points(points)
- hull_list <- list()
- for (i in seq_len(nrow(points_sorted))) {
- while (length(hull_list) > 2 && right_turn(
- hull_list[[length(hull_list) - 1]],
- hull_list[[length(hull_list)]],
- points_sorted[i, ]
- )) {
- hull_list[[length(hull_list)]] <- NULL
+add_or_remove_edge <- function(edge_front, edge, can_add = TRUE) {
+ for (i in seq_along(edge_front)) {
+ if (edge_inside(edge_front[[i]], edge)) {
+ return(c(
+ edge_front[-i],
+ remove_edge(edge_front[[i]], edge)
+ ))
+ }
+ }
+ if (can_add) {
+ edge_front <- c(edge_front, list(edge))
+ edge_front <- edge_front[order(vapply(edge_front, \(x) x[1], numeric(1)))]
+ i <- 1
+ repeat {
+ if (i >= length(edge_front)) break
+ if (max(edge_front[[i]]) == min(edge_front[[i + 1]])) {
+ edge_front[[i]] <- c(min(edge_front[[i]]), max(edge_front[[i + 1]]))
+ edge_front[[i + 1]] <- NULL
+ } else {
+ i <- i + 1
+ }
}
- hull_list[[length(hull_list) + 1]] <- points_sorted[i, ]
}
- do.call(rbind, hull_list)
+ edge_front
}
-measure_square <- function(p1, p2) {
- (abs(p1[1] - p2[1]) + 1) * (abs(p1[2] - p2[2]) + 1)
+points_in_edge_front <- function(edge_front, p) {
+ points_in_edge <- function(edge) {
+ min(p) >= min(edge) && max(p) <= max(edge)
+ }
+ any(vapply(edge_front, points_in_edge, logical(1)))
}
-largest_square_on_hull <- function(points) {
- hull <- convex_hull(points)
- largest_square <- NULL
- for (i in 1:(nrow(hull) - 1)) {
- for (j in 2:nrow(hull)) {
- largest_square <- max(
- largest_square,
- measure_square(hull[i, ], hull[j, ])
- )
+sweep_edge_front <- function(edge_info) {
+ max_rectangle <- NULL
+ start_front <- list()
+ for (y1_idx in 1:(length(edge_info$ind) - 1)) {
+ y1 <- edge_info$ind[y1_idx]
+ start_edges <- edge_info$tab[[y1]]
+ start_front <- Reduce(add_or_remove_edge, start_edges, start_front)
+ end_front <- start_front
+ for (x1 in unlist(start_edges)) {
+ for (y2_idx in (y1_idx + 1):length(edge_info$ind)) {
+ y2 <- edge_info$ind[y2_idx]
+ end_edges <- edge_info$tab[[y2]]
+ for (x2 in unlist(end_edges)) {
+ if (points_in_edge_front(start_front, c(x1, x2)) &&
+ points_in_edge_front(end_front, c(x1, x2))) {
+ max_rectangle <- max(
+ max_rectangle,
+ measure_rect(c(y1, x1), c(y2, x2))
+ )
+ }
+ }
+ end_front <- Reduce(\(x, y) add_or_remove_edge(x, y, FALSE), end_edges, end_front)
+ if (!points_in_edge_front(end_front, x1)) break
+ }
}
}
- largest_square
+ max_rectangle
}
-part1 <- function(input_lines) {
+part2 <- function(input_lines) {
input_lines |>
parse_input() |>
- largest_square_on_hull()
+ tabulate_edges() |>
+ sweep_edge_front()
}
-test_part1 <- function() {
- stopifnot(part1(test_input) == 50)
+test_part2 <- function() {
+ stopifnot(part2(test_input) == 24)
}
main <- function() {
test_part1()
cat("Part 1 solution: ", part1(puzzle_input), "\n")
+ test_part2()
+ cat("Part 2 solution: ", part2(puzzle_input), "\n")
}
main()
