如何正确解释ggplot的stat_density2d

Question

我最初的目标是绘制一个单独的点群，然后绘制一个凸起的船体，其中80％的人口集中在人口的质量上。

在尝试了很多想法后，我提出的最佳解决方案是使用ggplot的{​​{1}}。虽然这对于定性分析非常有用，但我仍然需要指出80％的边界。我开始寻找一种方法来勾勒出第80个百分位种群边界，但我可以使用80％概率密度边界。

这是我在寻求帮助的地方。 stat_density2d的{​​{1}}参数（由bin使用）未明确记录。如果我在下面的示例中设置kde2d = 4，我是否正确将中心（绿色）区域解释为包含25％概率质量，并将组合的黄色，红色和绿色区域表示为75％概率质量？如果是这样，通过将bin更改为= 5，那么内接区域是否会等于80％的概率质量？

stat_density2d

我重复了一些测试用例，并手动计算了被排除的点数[希望找到一种方法来计算它们基于什么......它们被包含在内...]但是给出了数据的随机性（两者都是我的真实数据和测试数据）bin区域之外的点数变化足以保证寻求帮助。

总结一下，是否有一种实用的方法可以在数据框中的80％中心点周围绘制多边形？或者说，我可以安全地使用set.seed(1) n=100 df <- data.frame(x=rnorm(n, 0, 1), y=rnorm(n, 0, 1)) TestData <- ggplot (data = df) + stat_density2d(aes(x = x, y = y, fill = as.factor(..level..)), bins=4, geom = "polygon", ) + geom_point(aes(x = x, y = y)) + scale_fill_manual(values = c("yellow","red","green","royalblue", "black")) TestData 并将bin设置为等于5以产生80％的概率质量？

---

Bryan Hanson的优秀答案消除了我可以在stat_density2d中传递未记录的stat_density2d参数的模糊概念。结果看起来接近4 {6左右bin的值，但正如他所说，实际功能是未知的，因此无法使用。

我使用了DWin接受的答案中提供的HDRegionplot来解决我的问题。为此，我在stat_density2d包中添加了重心（bin）并指向多边形（COGravity）以完成分析。

pnt.in.poly

Answer 1

好吧，让我首先说我不完全确定这个答案，这只是一个部分答案！ bin没有MASS::kde2d参数，这是[{1}}使用的函数。查看stat_density2d的帮助页面及其代码（只需在控制台中输入函数名称即可看到），我认为kde2d参数为bin（这些函数如何知道然而，将h传递给bin并不清楚。在帮助页面之后，我们看到如果未提供h，则由h计算。该功能的帮助页面说明了这一点：

MASS:bandwidth.nrd

基于此，我认为你最后一个问题（“我安全......”）的答案肯定是否定的。上述函数中的# The function is currently defined as function(x) { r <- quantile(x, c(0.25, 0.75)) h <- (r[2] - r[1])/1.34 4 * 1.06 * min(sqrt(var(x)), h) * length(x)^(-1/5) } 是您保证安全所需的，但它已被明确修改，因此您不安全。 HTH。

补充一点：您是否有证据表明您的代码正在使用r参数？我想知道它是否被忽略了。如果是，请尝试传递bins代替h并查看是否收听。

Answer 2

HPDregionplot in package：emdbook应该这样做。它确实使用MASS :: kde2d，但它将结果标准化。我的缺点是它需要一个mcmc对象。

library(MASS)
library(coda)
HPDregionplot(mcmc(data.matrix(df)), prob=0.8)
with(df, points(x,y))

Answer 3

基于42的答案，我简化了HPDregionplot()以减少依赖性并消除了使用mcmc对象的要求。该函数在两列data.frame上起作用，并且不创建中间图。但是请注意，一旦grDevices::contourLines()返回多个轮廓，此方法就会中断。

hpd_contour <- function (x, n = 50, prob = 0.95, ...) {
  post1 <- MASS::kde2d(x[[1]], x[[2]], n = n, ...)

  dx <- diff(post1$x[1:2])
  dy <- diff(post1$y[1:2])
  sz <- sort(post1$z)
  c1 <- cumsum(sz) * dx * dy

  levels <- sapply(prob, function(x) {
    approx(c1, sz, xout = 1 - x)$y
  })

  as.data.frame(grDevices::contourLines(post1$x, post1$y, post1$z, levels = levels))
}

theme_set(theme_bw(16))
set.seed(1)
n=100

df <- data.frame(x=rnorm(n, 0, 1), y=rnorm(n, 0, 1))
ContourLines <- hpd_contour(df, prob=0.8)

ggplot(df, aes(x = x, y = y)) +
  stat_density2d(aes(fill = as.factor(..level..)), bins=5, geom = "polygon") +
  geom_point() +
  geom_polygon(data = ContourLines, color = "blue", fill = NA) +
  scale_fill_manual(values = c("yellow","red","green","royalblue", "brown", "black", "white", "black", "white","black")) +
  scale_colour_manual(values = c("red", "black"))

此外，工作流现在可以轻松扩展到分组数据。

ContourLines <- iris[, c("Species", "Sepal.Length", "Sepal.Width")] %>% 
  group_by(Species) %>% 
  do(hpd_contour(.[, c("Sepal.Length", "Sepal.Width")], prob=0.8))

ggplot(data = iris, aes(x = Sepal.Length, y = Sepal.Width, color = Species)) +
  geom_point(size = 3, alpha = 0.6) +
  geom_polygon(data = ContourLines, fill = NA) +
  guides(color = FALSE) +
  theme(plot.margin = margin())