将vline添加到geom_density并平均均值R
在阅读了不同的帖子后，我发现如何在密度图中添加均值的vline，如here所示。 使用上面链接中提供的数据：
1）如何使用geom_ribbon在均值周围增加95％的置信区间？ CI可以计算为
#computation of the standard error of the mean
sem<-sd(x)/sqrt(length(x))
#95% confidence intervals of the mean
c(mean(x)-2*sem,mean(x)+2*sem)
2）如何将vline限制在曲线下的区域？您将在下面的图片中看到曲线外的vline图。
可以在https://www.dropbox.com/s/bvvfdpgekbjyjh0/test.csv?dl=0
找到非常接近我真实问题的示例数据 
更新
使用上面链接中的真实数据，我使用@ beetroot的答案尝试了以下内容。
# Find the mean of each group
dat=me
library(dplyr)
library(plyr)
cdat <- ddply(data,.(direction,cond), summarise, rating.mean=mean(rating,na.rm=T))# summarize by season and variable
cdat
#ggplot
p=ggplot(data,aes(x = rating)) +
geom_density(aes(colour = cond),size=1.3,adjust=4)+
facet_grid(.~direction, scales="free")+
xlab(NULL) + ylab("Density")
p=p+coord_cartesian(xlim = c(0, 130))+scale_color_manual(name="",values=c("blue","#00BA38","#F8766D"))+
scale_fill_manual(values=c("blue", "#00BA38", "#F8766D"))+
theme(legend.title = element_text(colour="black", size=15, face="plain"))+
theme(legend.text = element_text(colour="black", size = 15, face = "plain"))+
theme(title = red.bold.italic.text, axis.title = red.bold.italic.text)+
theme(strip.text.x = element_text(size=20, color="black",face="plain"))+ # facet labels
ggtitle("SAMPLE A") +theme(plot.title = element_text(size = 20, face = "bold"))+
theme(axis.text = blue.bold.italic.16.text)+ theme(legend.position = "none")+
geom_vline(data=cdat, aes(xintercept=rating.mean, color=cond),linetype="dotted",size=1)
p
## implementing @beetroot's code to restrict lines under the curve and shade CIs around the mean
# I will use ddply for mean and CIs
cdat <- ddply(data,.(direction,cond), summarise, rating.mean=mean(rating,na.rm=T),
sem = sd(rating,na.rm=T)/sqrt(length(rating)),
ci.low = mean(rating,na.rm=T) - 2*sem,
ci.upp = mean(rating,na.rm=T) + 2*sem)# summarize by direction and variable
#In order to limit the lines to the outline of the curves you first need to find out which y values
#of the curves correspond to the means, e.g. by accessing the density values with ggplot_build and
#using approx:
cdat.dens <- ggplot_build(ggplot(data, aes(x=rating, colour=cond)) +
facet_grid(.~direction, scales="free")+
geom_density(aes(colour = cond),size=1.3,adjust=4))$data[[1]] %>%
mutate(cond = ifelse(group==1, "A",
ifelse(group==2, "B","C"))) %>%
left_join(cdat) %>%
select(y, x, cond, rating.mean, sem, ci.low, ci.upp) %>%
group_by(cond) %>%
mutate(dens.mean = approx(x, y, xout = rating.mean)[[2]],
dens.cilow = approx(x, y, xout = ci.low)[[2]],
dens.ciupp = approx(x, y, xout = ci.upp)[[2]]) %>%
select(-y, -x) %>%
slice(1)
cdat.dens
#---
#You can then combine everything with various geom_segments:
ggplot(data, aes(x=rating, colour=cond)) +
geom_density(data = data, aes(x = rating, colour = cond),size=1.3,adjust=4) +facet_grid(.~direction, scales="free")+
geom_segment(data = cdat.dens, aes(x = rating.mean, xend = rating.mean, y = 0, yend = dens.mean, colour = cond),
linetype = "dashed", size = 1) +
geom_segment(data = cdat.dens, aes(x = ci.low, xend = ci.low, y = 0, yend = dens.cilow, colour = cond),
linetype = "dotted", size = 1) +
geom_segment(data = cdat.dens, aes(x = ci.upp, xend = ci.upp, y = 0, yend = dens.ciupp, colour = cond),
linetype = "dotted", size = 1)
给出这个：
您会注意到平均值和CI未在原始图中对齐。 @beetroot我做得怎么样？
2 个答案:
答案 0 :(得分：4)
使用链接中的数据，您可以像这样计算均值，se和ci（我建议使用dplyr的继承者plyr）：
set.seed(1234)
dat <- data.frame(cond = factor(rep(c("A","B"), each=200)),
rating = c(rnorm(200),rnorm(200, mean=.8)))
library(ggplot2)
library(dplyr)
cdat <- dat %>%
group_by(cond) %>%
summarise(rating.mean = mean(rating),
sem = sd(rating)/sqrt(length(rating)),
ci.low = mean(rating) - 2*sem,
ci.upp = mean(rating) + 2*sem)
为了将线限制为曲线的轮廓，首先需要找出曲线的哪些y值对应于平均值，例如：通过使用ggplot_build并使用approx：
cdat.dens <- ggplot_build(ggplot(dat, aes(x=rating, colour=cond)) + geom_density())$data[[1]] %>%
mutate(cond = ifelse(group == 1, "A", "B")) %>%
left_join(cdat) %>%
select(y, x, cond, rating.mean, sem, ci.low, ci.upp) %>%
group_by(cond) %>%
mutate(dens.mean = approx(x, y, xout = rating.mean)[[2]],
dens.cilow = approx(x, y, xout = ci.low)[[2]],
dens.ciupp = approx(x, y, xout = ci.upp)[[2]]) %>%
select(-y, -x) %>%
slice(1)
> cdat.dens
Source: local data frame [2 x 8]
Groups: cond [2]
cond rating.mean sem ci.low ci.upp dens.mean dens.cilow dens.ciupp
<chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 A -0.05775928 0.07217200 -0.2021033 0.08658471 0.3865929 0.403623 0.3643583
2 B 0.87324927 0.07120697 0.7308353 1.01566320 0.3979347 0.381683 0.4096153
然后，您可以将所有内容与各种geom_segment s：
ggplot() +
geom_density(data = dat, aes(x = rating, colour = cond)) +
geom_segment(data = cdat.dens, aes(x = rating.mean, xend = rating.mean, y = 0, yend = dens.mean, colour = cond),
linetype = "dashed", size = 1) +
geom_segment(data = cdat.dens, aes(x = ci.low, xend = ci.low, y = 0, yend = dens.cilow, colour = cond),
linetype = "dotted", size = 1) +
geom_segment(data = cdat.dens, aes(x = ci.upp, xend = ci.upp, y = 0, yend = dens.ciupp, colour = cond),
linetype = "dotted", size = 1)
正如Axeman指出的那样，您可以根据功能区创建多边形，如this answer中所述。
因此，对于您的数据，您可以进行子集化并添加其他行，如下所示：
ribbon <- ggplot_build(ggplot(dat, aes(x=rating, colour=cond)) + geom_density())$data[[1]] %>%
mutate(cond = ifelse(group == 1, "A", "B")) %>%
left_join(cdat.dens) %>%
group_by(cond) %>%
filter(x >= ci.low & x <= ci.upp) %>%
select(cond, x, y)
ribbon <- rbind(data.frame(cond = c("A", "B"), x = c(-0.2021033, 0.7308353), y = c(0, 0)),
as.data.frame(ribbon),
data.frame(cond = c("A", "B"), x = c(0.08658471, 1.01566320), y = c(0, 0)))
将geom_polygon添加到情节中：
ggplot() +
geom_polygon(data = ribbon, aes(x = x, y = y, fill = cond), alpha = .5) +
geom_density(data = dat, aes(x = rating, colour = cond)) +
geom_segment(data = cdat.dens, aes(x = rating.mean, xend = rating.mean, y = 0, yend = dens.mean, colour = cond),
linetype = "dashed", size = 1) +
geom_segment(data = cdat.dens, aes(x = ci.low, xend = ci.low, y = 0, yend = dens.cilow, colour = cond),
linetype = "dotted", size = 1) +
geom_segment(data = cdat.dens, aes(x = ci.upp, xend = ci.upp, y = 0, yend = dens.ciupp, colour = cond),
linetype = "dotted", size = 1)
这是适用于您的真实数据的代码。合并两个组而不是一个组有点棘手：
cdat <- dat %>%
group_by(direction, cond) %>%
summarise(rating.mean = mean(rating, na.rm = TRUE),
sem = sd(rating, na.rm = TRUE)/sqrt(length(rating)),
ci.low = mean(rating, na.rm = TRUE) - 2*sem,
ci.upp = mean(rating, na.rm = TRUE) + 2*sem)
cdat.dens <- ggplot_build(ggplot(dat, aes(x=rating, colour=interaction(direction, cond))) + geom_density())$data[[1]] %>%
mutate(cond = ifelse((group == 1 | group == 2 | group == 3 | group == 4), "A",
ifelse((group == 5 | group == 6 | group == 7 | group == 8), "B", "C")),
direction = ifelse((group == 1 | group == 5 | group == 9), "EAST",
ifelse((group == 2 | group == 6 | group == 10), "NORTH",
ifelse((group == 3 | group == 7 | group == 11), "SOUTH", "WEST")))) %>%
left_join(cdat) %>%
select(y, x, cond, direction, rating.mean, sem, ci.low, ci.upp) %>%
group_by(cond, direction) %>%
mutate(dens.mean = approx(x, y, xout = rating.mean)[[2]],
dens.cilow = approx(x, y, xout = ci.low)[[2]],
dens.ciupp = approx(x, y, xout = ci.upp)[[2]]) %>%
select(-y, -x) %>%
slice(1)
ggplot() +
geom_density(data = dat, aes(x = rating, colour = cond)) +
geom_segment(data = cdat.dens, aes(x = rating.mean, xend = rating.mean, y = 0, yend = dens.mean, colour = cond),
linetype = "dashed", size = 1) +
geom_segment(data = cdat.dens, aes(x = ci.low, xend = ci.low, y = 0, yend = dens.cilow, colour = cond),
linetype = "dotted", size = 1) +
geom_segment(data = cdat.dens, aes(x = ci.upp, xend = ci.upp, y = 0, yend = dens.ciupp, colour = cond),
linetype = "dotted", size = 1) +
facet_wrap(~direction)
答案 1 :(得分：0)
如果您想在不构建绘图对象的情况下绘制平均线并且在绘图之前不操作数据，您可以使用 stat_summary()：
(
ggplot(data = dat, aes(x = rating, colour = cond))
+ geom_density()
+ stat_summary(
aes(y = rating, x = 0),
geom = 'rect',
fun.data = density_mean_line(dat$rating),
key_glyph = "vline",
size = 1
)
)
给予：
哪里：
density_mean_line = function(values) {
values_range = range(values, na.rm=TRUE)
function(x) {
density_data = StatDensity$compute_group(
data.frame(x=x),
scales=list(
x=scale_x_continuous(limits = values_range)
)
)
mean_x = mean(x)
data.frame(
xmin=mean_x,
xmax=mean_x,
ymin=0,
ymax=approx(density_data$x, density_data$density, xout=mean_x)$y
)
}
}
并且 dat 在 erc 的回答中定义：
set.seed(1234)
dat <- data.frame(cond = factor(rep(c("A","B"), each=200)),
rating = c(rnorm(200),rnorm(200, mean=.8)))
此技术还可用于生成实心区域（与密度轮廓颜色相同）：
(
ggplot(data = dat, aes(x = rating, colour = cond, group = cond))
+ stat_summary(
aes(y = rating, x = 0, fill = cond),
geom = 'rect',
fun.data = density_ci(dat$rating),
size=1
)
+ stat_summary(
aes(y = rating, x = 0),
geom = 'rect',
fun.data = density_mean_line(dat$rating),
key_glyph = "vline",
size = 0.5,
color='grey20'
)
+ geom_density()
)
哪里：
density_ci = function(values, resolution=100) {
values_range = range(values, na.rm=TRUE)
function(x) {
density_data = StatDensity$compute_group(
data.frame(x=x),
scales=list(
x=scale_x_continuous(limits = values_range)
)
)
mean_x = mean(x)
sem = sd(x) / sqrt(length(x))
ci_lower = mean_x - 1.96 * sem
ci_upper = mean_x + 1.96 * sem
x_values = seq(ci_lower, ci_upper, length.out=resolution)
data.frame(
xmin=x_values,
xmax=x_values,
ymin=rep(0, resolution),
ymax=approx(density_data$x, density_data$density, xout=x_values)$y
)
}
}
相关问题
最新问题
- 我写了这段代码，但我无法理解我的错误
- 我无法从一个代码实例的列表中删除 None 值，但我可以在另一个实例中。为什么它适用于一个细分市场而不适用于另一个细分市场？
- 是否有可能使 loadstring 不可能等于打印？卢阿
- java中的random.expovariate()
- Appscript 通过会议在 Google 日历中发送电子邮件和创建活动
- 为什么我的 Onclick 箭头功能在 React 中不起作用？
- 在此代码中是否有使用“this”的替代方法？
- 在 SQL Server 和 PostgreSQL 上查询，我如何从第一个表获得第二个表的可视化
- 每千个数字得到
- 更新了城市边界 KML 文件的来源？