如何绘制一条等高线，显示95%的值在R和ggplot2范围内

假设我们有：

x <- rnorm(1000)
y <- rnorm(1000)

---

x这是可行的，但效率很低，因为实际上必须计算内核密度估计值三次

set.seed(1001)
d <- data.frame(x=rnorm(1000),y=rnorm(1000))
getLevel <- function(x,y,prob=0.95) {
    kk <- MASS::kde2d(x,y)
    dx <- diff(kk$x[1:2])
    dy <- diff(kk$y[1:2])
    sz <- sort(kk$z)
    c1 <- cumsum(sz) * dx * dy
    approx(c1, sz, xout = 1 - prob)$y
}
L95 <- getLevel(d$x,d$y)
library(ggplot2); theme_set(theme_bw())
ggplot(d,aes(x,y)) +
   stat_density2d(geom="tile", aes(fill = ..density..),
                  contour = FALSE)+
   stat_density2d(colour="red",breaks=L95)


从
kk
网格执行95%级别的计算（将内核计算的数量减少到1）留作练习
我不确定为什么
stat\u density2d（geom=“tile”）
和
geom\u tile
会给出稍微不同的结果（前者是平滑的）
我没有添加双变量平均值，但是类似于
注释（“点”，x=mean（d$x），y=mean（d$y），color=“red”）的东西应该可以工作

我举了一个例子，其中
MASS:：kde2d（）
带宽规范不够灵活，因此我最终使用了
ks
包和
ks:：kde（）
函数以及
ks:：Hscv（）
函数来估计更能体现平滑度的灵活带宽。这种计算可能有点慢，但在某些情况下它的性能要好得多。以下是该示例的上述代码版本：

set.seed(1001)
d <- data.frame(x=rnorm(1000),y=rnorm(1000))
getLevel <- function(x,y,prob=0.95) {
    kk <- MASS::kde2d(x,y)
    dx <- diff(kk$x[1:2])
    dy <- diff(kk$y[1:2])
    sz <- sort(kk$z)
    c1 <- cumsum(sz) * dx * dy
    approx(c1, sz, xout = 1 - prob)$y
}
L95 <- getLevel(d$x,d$y)
library(ggplot2); theme_set(theme_bw())
ggplot(d,aes(x,y)) +
    stat_density2d(geom="tile", aes(fill = ..density..),
                   contour = FALSE)+
    stat_density2d(colour="red",breaks=L95)

## using ks::kde
hscv1 <- Hscv(d)
fhat <- ks::kde(d, H=hscv1, compute.cont=TRUE)

dimnames(fhat[['estimate']]) <- list(fhat[["eval.points"]][[1]], 
                                     fhat[["eval.points"]][[2]])
library(reshape2)
aa <- melt(fhat[['estimate']])

ggplot(aa, aes(x=Var1, y=Var2)) +
    geom_tile(aes(fill=value)) +
    geom_contour(aes(z=value), breaks=fhat[["cont"]]["50%"], color="red") +
    geom_contour(aes(z=value), breaks=fhat[["cont"]]["5%"], color="purple") 

set.seed（1001）
d不幸的是，接受的答案当前失败，出现
错误：未知参数：在
ggplot2.1.0
上出现中断。我根据中的代码拼凑出一种替代方法，它使用
ks
包计算内核密度估计：

library(ggplot2)

set.seed(1001)
d <- data.frame(x=rnorm(1000),y=rnorm(1000))

kd <- ks::kde(d, compute.cont=TRUE)
contour_95 <- with(kd, contourLines(x=eval.points[[1]], y=eval.points[[2]],
                                    z=estimate, levels=cont["5%"])[[1]])
contour_95 <- data.frame(contour_95)

ggplot(data=d, aes(x, y)) +
  geom_point() +
  geom_path(aes(x, y), data=contour_95) +
  theme_bw()

库（ggplot2）
种子集（1001）
d套用本·博尔克的答案，这是一个可以处理多个级别并与ggplot 2.2.1一起工作的解决方案：

library(ggplot2)
library(MASS)
library(reshape2)
# create data:
set.seed(8675309)
Sigma <- matrix(c(0.1,0.3,0.3,4),2,2)
mv <- data.frame(mvrnorm(4000,c(1.5,16),Sigma))

# get the kde2d information: 
mv.kde <- kde2d(mv[,1], mv[,2], n = 400)
dx <- diff(mv.kde$x[1:2])  # lifted from emdbook::HPDregionplot()
dy <- diff(mv.kde$y[1:2])
sz <- sort(mv.kde$z)
c1 <- cumsum(sz) * dx * dy

# specify desired contour levels:
prob <- c(0.95,0.90,0.5)

# plot:
dimnames(mv.kde$z) <- list(mv.kde$x,mv.kde$y)
dc <- melt(mv.kde$z)
dc$prob <- approx(sz,1-c1,dc$value)$y
p <- ggplot(dc,aes(x=Var1,y=Var2))+
  geom_contour(aes(z=prob,color=..level..),breaks=prob)+
  geom_point(aes(x=X1,y=X2),data=mv,alpha=0.1,size=1)
print(p)

库（ggplot2）
图书馆（弥撒）
图书馆（E2）
#创建数据：
种子集（8675309）
Sigma只需混合上面的答案，以更友好的方式将它们放置在
tidyverse
中，并允许多个轮廓级别。我在这里使用
geom\u path（group=probs）
，手动添加它们
geom\u text
。另一种方法是使用
geom_path（color=probs）
自动将轮廓标记为图例

库（ks）
图书馆（tidyverse）
种子集（1001）
##资料
d%
magrittr:：set_colnames（c（“x”，“y”））%>%
作为_tible（）
##密度函数
kd%
解组（）
##清洁kde输出
kd_df%
变异（z=c（kd$estimate%>%t））
ggplot（数据=kd_-df，aes（x，y））+
geom_瓷砖（aes（填充=z））+
几何点（数据=d，α=I（0.4），尺寸=I（0.4），颜色=I（“黄色”））+
几何路径（aes（x，y，组=prob），
数据=过滤器（数据输出，！n值%1:3，颜色=I（“白色”））+
几何图形文本（aes（标签=prob），数据=
过滤器（dat_out，（在%c（“10%，“20%，“80%”）中的prob%和n_val==1）|（在%c中的prob%和n_val==20）），
颜色=I（“黑色”），尺寸=I（3））+
鳞片_填充_绿色_c（）+
主题_bw（）+
主题（legend.position=“无”）


由（v0.3.0）于2019-06-25创建的
stat\u density2d
不正是第1部分所需的吗？对于第2部分（包含95%概率的等高线），我可以向您展示如何确定ggplot2之外的相关截止密度，然后使用该密度指定等高线，但我认为，如果没有一些极端的技巧（即编写自己的统计/几何组件），在ggplot2内不可能全部完成。这似乎显示了y~x的边界。我在寻找x-y平面上的平滑多边形，该多边形划分了95%散射（或基于散射的密度）所在的区域。谢谢。我的意思是我想通过一个点来总结很多二元值，这个点显示分布的中心（第1部分），一条等高线显示估计值集中在哪里。i、 e.以图形方式在二维上做一些类似于分位数（x，probs=c（0.025，0.5，0.975））在一维上所做的事情。感谢您迄今为止的帮助。当我单独使用图形软件包时，我知道以下几点，这是一种可行的方法，但我希望在ggplot2中也能有这样一种选择，因为默认的美学效果更好。非常感谢。非常好，我相信我会用很多次。效率低下是相对的，因为任何有效的方法都比无效的方法有效得多！很好的解决方案，非常感谢——我也在找类似的东西。请注意，虽然生成的等高线将包含95%的概率密度，但实际上在大多数情况下，它将包含95%以上的实际观测值。仅供参考，这（第一个示例）目前在
ggplot2 2.1.0
上引发了一个错误（
error:Unknown parameters:breaks
）。您可能知道如何调整代码以使其再次工作吗？看起来真的很有用！不知道，对不起。也许会问一个新问题？我用中的代码拼凑了一些东西，我会把它作为另一个解决方案发布：）谢谢你的回复！
library(ggplot2)

set.seed(1001)
d <- data.frame(x=rnorm(1000),y=rnorm(1000))

kd <- ks::kde(d, compute.cont=TRUE)
contour_95 <- with(kd, contourLines(x=eval.points[[1]], y=eval.points[[2]],
                                    z=estimate, levels=cont["5%"])[[1]])
contour_95 <- data.frame(contour_95)

ggplot(data=d, aes(x, y)) +
  geom_point() +
  geom_path(aes(x, y), data=contour_95) +
  theme_bw()

library(ggplot2)
library(MASS)
library(reshape2)
# create data:
set.seed(8675309)
Sigma <- matrix(c(0.1,0.3,0.3,4),2,2)
mv <- data.frame(mvrnorm(4000,c(1.5,16),Sigma))

# get the kde2d information: 
mv.kde <- kde2d(mv[,1], mv[,2], n = 400)
dx <- diff(mv.kde$x[1:2])  # lifted from emdbook::HPDregionplot()
dy <- diff(mv.kde$y[1:2])
sz <- sort(mv.kde$z)
c1 <- cumsum(sz) * dx * dy

# specify desired contour levels:
prob <- c(0.95,0.90,0.5)

# plot:
dimnames(mv.kde$z) <- list(mv.kde$x,mv.kde$y)
dc <- melt(mv.kde$z)
dc$prob <- approx(sz,1-c1,dc$value)$y
p <- ggplot(dc,aes(x=Var1,y=Var2))+
  geom_contour(aes(z=prob,color=..level..),breaks=prob)+
  geom_point(aes(x=X1,y=X2),data=mv,alpha=0.1,size=1)
print(p)