仅在R中绘制ggplot stat_density_2d/geom_density_2d的顶层

7cwmlq89 于 2023-06-27 发布在其他

关注(0)|答案(2)|浏览(99)

我尝试在R中使用ggplot生成等高线图，但只保留图的顶层。例如，使用以下玩具数据：

df <- data.frame(x=rnorm(2000, 10, 3), y=rnorm(2000, 10, 3))
stat_density_plot <- ggplot(df, aes(x, y)) +
                      geom_point() +
                      stat_density_2d(aes(fill = ..level..), geom = "polygon", bins=15) 
geom_density_plot <- ggplot(df, aes(x, y)) +
                      geom_point() +
                      geom_density_2d(bins = 15, color = "red")

我希望在stat_density_plot中只绘制前4个水平，在geom_density_plot中只绘制最里面的4个等高线。
我一直在考虑自己生成核密度估计（MASS::kde2d(df$x, df$y)）并手动删除所有其余层的想法，但我仍然不知道如何使用ggplot绘制结果。
任何关于如何生成这两个图中的任何一个的见解都将是最受欢迎的。

来源：https://stackoverflow.com/questions/76533721/plot-only-top-layers-of-ggplot-stat-density-2d-geom-density-2d-in-r

2条答案

按热度按时间

dzjeubhm1#

您可以使用layer_data()来获取ggplot用于创建多边形/线的实际数据，并专注于您想要的级别。

# original
geom_density_plot <- ggplot(df, aes(x, y)) +
  geom_point() +
  geom_density_2d(bins = 15, color = "red", linewidth = 2) # thicker for better visibility

# filtered for desired rings (group numbering goes from outermost to innermost
# so we reverse that before filtering for the first four groups, which now
# correspond to the innermost rings)
layer_data(geom_density_plot, 2L) %>% 
  mutate(group = forcats::fct_rev(group)) %>%
  filter(as.integer(group) <= 4) %>%
  ggplot(aes(x = x, y = y)) +
  geom_point(data = df) +
  geom_path(aes(group = group), color = "red", linewidth = 2)

# original
stat_density_plot <- ggplot(df, aes(x, y)) +
  geom_point() +
  stat_density_2d(aes(fill = after_stat(level)), # after_stat is used in more recent versions of ggplot; the `...level...` syntax is considered old now
                  geom = "polygon", bins=15) 

# set transparency of unwanted levels to zero (we don't filter out the unwanted
# levels here, as the full range of levels is required to match the colour palette
# of the original)
layer_data(stat_density_plot, 2L) %>% 
  mutate(group1 = forcats::fct_rev(group)) %>%
  ggplot(aes(x = x, y = y)) +
  geom_point(data = df) +
  geom_polygon(aes(group = group, fill = level, 
                   alpha = ifelse(as.integer(group1) <= 4, 1, 0))) +
  scale_alpha_identity()

赞(0）回复(0）举报 2023-06-27

wribegjk2#

免责声明：此答案基于此问题How to plot a contour line showing where 95% of values fall within, in R and in ggplot2中的答案
您可以手动计算内核密度esitmate，并通过指定概率间隔，使用结果数据更好地控制图上显示的内容。

# calculate kde
kde <- MASS::kde2d(df$x, df$y, n = 100)

# process kde
dx <- diff(kde$x[1:2])
dy <- diff(kde$y[1:2])
sz <- sort(kde$z)
c1 <- cumsum(sz) * dx * dy
dimnames(kde$z) <- list(kde$x, kde$y)
dc <- melt(kde$z)
dc$prob <- approx(sz, 1 - c1, dc$value)$y

# set probability levels for plot
binwidth <- 1/15
prob <- c(0, binwidth, binwidth * 2, binwidth * 3, binwidth * 4)
# or prob <- c(0, 0.25, 0.5) for example

# plot with discrete levels
ggplot(dc, aes(x = Var1, y = Var2)) +
  geom_point(data = df, aes(x = x, y = y), alpha = 0.2) +
  geom_contour_filled(aes(z = prob, fill = after_stat(level)),
                      breaks = prob,
                      alpha = 0.9) +
  geom_contour(aes(z = prob),
               breaks = prob,
               color = "red",
               alpha = 0.9) +
  scale_fill_brewer(palette = "Blues",
                    direction = -1,
                    name = "probability") +
  labs(x = "x", y = "y")

# plot with continuous levels using level_low
ggplot(dc, aes(x = Var1, y = Var2)) +
  geom_point(data = df, aes(x = x, y = y), alpha = 0.2) +
  geom_contour_filled(aes(z = prob, fill = after_stat(level_high)),
                      breaks = prob,
                      alpha = 0.9) +
  geom_contour(aes(z = prob),
               breaks = prob,
               color = "red",
               alpha = 0.9) +
  labs(x = "x", y = "y", fill = "probability")

原始图中有15个箱，因此这是本例中中断的基数（1/15）。生成的图将仅显示前4个等高线。