如何在R中创建各等高线颜色按内部点密度单独缩放的等高线图

• 第一步：先计算全局二维密度，切分等高线层级：用MASS::kde2d()计算所有点的核密度，再用grDevices::contourLines()提取所有等高线的多边形边界
• 第二步：给每个点分配所属的等高线层级：用sf包的空间判断能力，识别每个点落在哪个等高线多边形内部
• 第三步：分组计算层级内密度：按所属等高线分组，单独对每个组内的点计算局部密度，把局部密度标准化到0-1区间作为颜色映射值
• 第四步：绘图：用ggplot2先绘制映射了局部密度颜色的点，再叠加等高线边框即可

library(MASS)
library(sf)
library(ggplot2)
library(dplyr)

# 模拟测试数据，可替换为你自己的数据集
set.seed(123)
dat <- rbind(
  data.frame(x = rnorm(1000, 0, 1), y = rnorm(1000, 0, 1)),
  data.frame(x = rnorm(2000, 3, 0.5), y = rnorm(2000, 3, 0.8))
)

# 1. 计算全局二维密度，提取等高线
kde <- kde2d(dat$x, dat$y, n = 100)
# 自定义等高线层级，可调整分位数数量控制等高线条数
contours <- contourLines(kde, levels = quantile(kde$z, seq(0.1, 0.9, 0.2)))

# 2. 把等高线转成sf多边形对象，给每个等高线分配唯一ID
contour_sf <- lapply(seq_along(contours), function(i) {
  poly_coords <- cbind(contours[[i]]$x, contours[[i]]$y)
  st_polygon(list(poly_coords)) %>% 
    st_sfc(crs = NA) %>% 
    st_sf(contour_id = i, level = contours[[i]]$level)
}) %>% bind_rows()

# 3. 给每个点匹配所属的等高线
point_sf <- st_as_sf(dat, coords = c("x", "y"), crs = NA)
point_contour <- st_join(point_sf, contour_sf, join = st_within)

# 4. 按等高线分组计算局部标准化密度
point_density <- point_contour %>%
  filter(!is.na(contour_id)) %>%
  group_by(contour_id) %>%
  mutate(
    # 示例用组内到重心的距离近似密度，也可以对组内单独调用kde2d计算更精准的密度
    center_x = mean(st_coordinates(geometry)[,1]),
    center_y = mean(st_coordinates(geometry)[,2]),
    dist_center = sqrt((st_coordinates(geometry)[,1] - center_x)^2 + 
                        (st_coordinates(geometry)[,2] - center_y)^2),
    local_density_norm = 1 - scales::rescale(dist_center) # 距离中心越近密度值越高
  ) %>%
  ungroup()

# 5. 绘制最终效果图
ggplot() +
  geom_sf(data = point_density, aes(color = local_density_norm), size = 0.8) +
  geom_sf(data = contour_sf, fill = NA, color = "black", linewidth = 0.3) +
  scale_color_viridis_c() +
  theme_minimal() +
  labs(color = "层级内相对密度")

• 若需要更精准的组内密度，可以替换第四步的距离计算逻辑，对每个等高线组内的点单独调用kde2d计算组内密度值再标准化
• 等高线的层级数量可以通过修改contourLines的levels参数调整，匹配你需要的斑马图分层效果
• 如果处理大数据集时运行卡顿，可以先对数据集做随机抽样，或者降低kde2d的n参数值提升计算速度

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