如何在ggplot2热力图/栅格图中高亮感兴趣区域（无需terra包）

我需要在ggplot2绘制的热力图/栅格图中标记感兴趣区域，数据是包含三个变量的连续数据（非空间数据）。目前已通过terra包实现了用多边形标记自定义阈值区域的方案，但希望找到无需依赖terra包的更简洁优雅的替代方法。

原实现代码：

library(ggplot2)
library(dplyr)
library(terra)

data("faithfuld")

# rasterize the data with terra
ncol <- faithfuld |> distinct(waiting) |> nrow()
nrow <- faithfuld |> distinct(eruptions) |> nrow()
xmin <- faithfuld$waiting |> min()
xmax <- faithfuld$waiting |> max()
ymin <- faithfuld$eruptions |> min()
ymax <- faithfuld$eruptions |> max()

faithful_vec <- vect(faithfuld, geom = c("waiting", "eruptions"))

r1 <- rast(ncol=ncol, nrow=nrow, xmin=xmin, xmax=xmax, ymin=ymin, ymax=ymax)
r1 <- rasterize(faithful_vec, r1, "density", mean)

# filter values to highlight
r1[r1 < 0.025] <- NA

# convert to polygon and grab geometry
r2 <- as.polygons(r1) |> 
  geom() |> 
  as_tibble()

ggplot() +
  geom_raster(data = faithfuld, aes(waiting, eruptions, fill = density), interpolate = TRUE) +
  ## highlighted area ##
  geom_polygon(data = r2, aes(x, y, group = part), color = "white", fill = "transparent") +
  scale_fill_viridis_c()

当前实现效果：

可以利用R基础包的contourLines()函数提取阈值对应的轮廓线，再转换为数据框后用geom_polygon()绘制标记区域，仅依赖ggplot2和dplyr：

library(ggplot2)
library(dplyr)
library(purrr)

data("faithfuld")

# 提取阈值0.025对应的轮廓线
contour_data <- contourLines(
  x = unique(faithfuld$waiting),
  y = unique(faithfuld$eruptions),
  z = matrix(faithfuld$density, nrow = length(unique(faithfuld$eruptions))),
  levels = 0.025
)

# 将轮廓线列表转换为可用于ggplot的数据框
contour_df <- contour_data |>
  map_dfr(~tibble(x = .x$x, y = .x$y), .id = "piece")

ggplot() +
  geom_raster(data = faithfuld, aes(waiting, eruptions, fill = density), interpolate = TRUE) +
  # 绘制标记多边形
  geom_polygon(data = contour_df, aes(x, y, group = piece), color = "white", fill = "transparent") +
  scale_fill_viridis_c()

方案说明 #

• contourLines()根据输入的x/y网格和z值，直接提取指定阈值的轮廓线坐标，返回列表格式结果
• 用map_dfr()将列表转换为数据框，同时为不同轮廓块添加分组标识，确保geom_polygon()能正确识别独立区域
• 最终效果与原terra方案完全一致，且仅依赖tidyverse核心包

如果不想引入purrr，可以用基础R代码完成数据转换：

# 基础R转换方法
contour_df <- do.call(rbind, lapply(seq_along(contour_data), function(i) {
  cl <- contour_data[[i]]
  data.frame(x = cl$x, y = cl$y, piece = as.character(i))
}))

内容的提问来源于stack exchange，提问作者mpschramm