[英]Shading a kernel density plot between two points.
I frequently use kernel density plots to illustrate distributions.我经常使用核密度图来说明分布。 These are easy and fast to create in R like so:
这些在 R 中创建起来既简单又快速,如下所示:
set.seed(1)
draws <- rnorm(100)^2
dens <- density(draws)
plot(dens)
#or in one line like this: plot(density(rnorm(100)^2))
Which gives me this nice little PDF:这给了我这个漂亮的小 PDF:
I'd like to shade the area under the PDF from the 75th to 95th percentiles.我想将 PDF 下的区域从 75% 到 95% 涂上阴影。 It's easy to calculate the points using the
quantile
function:使用
quantile
函数很容易计算点:
q75 <- quantile(draws, .75)
q95 <- quantile(draws, .95)
But how do I shade the the area between q75
and q95
?但是我如何遮蔽
q75
和q95
之间的区域?
With the polygon()
function, see its help page and I believe we had similar questions here too.使用
polygon()
函数,请参阅其帮助页面,我相信我们在这里也有类似的问题。
You need to find the index of the quantile values to get the actual (x,y)
pairs.您需要找到分位数值的索引以获得实际的
(x,y)
对。
Edit: Here you go:编辑:给你:
x1 <- min(which(dens$x >= q75))
x2 <- max(which(dens$x < q95))
with(dens, polygon(x=c(x[c(x1,x1:x2,x2)]), y= c(0, y[x1:x2], 0), col="gray"))
Output (added by JDL)输出(由 JDL 添加)
Another solution:另一种解决方案:
dd <- with(dens,data.frame(x,y))
library(ggplot2)
qplot(x,y,data=dd,geom="line")+
geom_ribbon(data=subset(dd,x>q75 & x<q95),aes(ymax=y),ymin=0,
fill="red",colour=NA,alpha=0.5)
Result:结果:
An expanded solution:扩展的解决方案:
If you wanted to shade both tails (copy & paste of Dirk's code) and use known x values:如果您想对两个尾部进行着色(复制和粘贴 Dirk 的代码)并使用已知的 x 值:
set.seed(1)
draws <- rnorm(100)^2
dens <- density(draws)
plot(dens)
q2 <- 2
q65 <- 6.5
qn08 <- -0.8
qn02 <- -0.2
x1 <- min(which(dens$x >= q2))
x2 <- max(which(dens$x < q65))
x3 <- min(which(dens$x >= qn08))
x4 <- max(which(dens$x < qn02))
with(dens, polygon(x=c(x[c(x1,x1:x2,x2)]), y= c(0, y[x1:x2], 0), col="gray"))
with(dens, polygon(x=c(x[c(x3,x3:x4,x4)]), y= c(0, y[x3:x4], 0), col="gray"))
Result:结果:
This question needs a lattice
answer.这个问题需要一个
lattice
答案。 Here's a very basic one, simply adapting the method employed by Dirk and others:这是一个非常基本的方法,简单地改编了 Dirk 和其他人采用的方法:
#Set up the data
set.seed(1)
draws <- rnorm(100)^2
dens <- density(draws)
#Put in a simple data frame
d <- data.frame(x = dens$x, y = dens$y)
#Define a custom panel function;
# Options like color don't need to be hard coded
shadePanel <- function(x,y,shadeLims){
panel.lines(x,y)
m1 <- min(which(x >= shadeLims[1]))
m2 <- max(which(x <= shadeLims[2]))
tmp <- data.frame(x1 = x[c(m1,m1:m2,m2)], y1 = c(0,y[m1:m2],0))
panel.polygon(tmp$x1,tmp$y1,col = "blue")
}
#Plot
xyplot(y~x,data = d, panel = shadePanel, shadeLims = c(1,3))
Here's another ggplot2
variant based on a function that approximates the kernel density at the original data values:这是另一个基于函数的
ggplot2
变体,该函数在原始数据值处近似核密度:
approxdens <- function(x) {
dens <- density(x)
f <- with(dens, approxfun(x, y))
f(x)
}
Using the original data (rather than producing a new data frame with the density estimate's x and y values) has the benefit of also working in faceted plots where the quantile values depend on the variable by which the data is being grouped:使用原始数据(而不是使用密度估计的 x 和 y 值生成新数据框)的好处是还可以在分位数图中工作,其中分位数值取决于数据分组所依据的变量:
Code used使用的代码
library(tidyverse)
library(RColorBrewer)
# dummy data
set.seed(1)
n <- 1e2
dt <- tibble(value = rnorm(n)^2)
# function that approximates the density at the provided values
approxdens <- function(x) {
dens <- density(x)
f <- with(dens, approxfun(x, y))
f(x)
}
probs <- c(0.75, 0.95)
dt <- dt %>%
mutate(dy = approxdens(value), # calculate density
p = percent_rank(value), # percentile rank
pcat = as.factor(cut(p, breaks = probs, # percentile category based on probs
include.lowest = TRUE)))
ggplot(dt, aes(value, dy)) +
geom_ribbon(aes(ymin = 0, ymax = dy, fill = pcat)) +
geom_line() +
scale_fill_brewer(guide = "none") +
theme_bw()
# dummy data with 2 groups
dt2 <- tibble(category = c(rep("A", n), rep("B", n)),
value = c(rnorm(n)^2, rnorm(n, mean = 2)))
dt2 <- dt2 %>%
group_by(category) %>%
mutate(dy = approxdens(value),
p = percent_rank(value),
pcat = as.factor(cut(p, breaks = probs,
include.lowest = TRUE)))
# faceted plot
ggplot(dt2, aes(value, dy)) +
geom_ribbon(aes(ymin = 0, ymax = dy, fill = pcat)) +
geom_line() +
facet_wrap(~ category, nrow = 2, scales = "fixed") +
scale_fill_brewer(guide = "none") +
theme_bw()
Created on 2018-07-13 by the reprex package (v0.2.0).由reprex 包(v0.2.0) 于 2018 年 7 月 13 日创建。
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.