如何在箱线图中添加一条线？

Question

我想在我的箱线图中的“mean”之间添加线条。

我的代码：

library(ggplot2)
library(ggthemes)

Gp=factor(c(rep("G1",80),rep("G2",80)))
Fc=factor(c(rep(c(rep("FC1",40),rep("FC2",40)),2)))
Z <-factor(c(rep(c(rep("50",20),rep("100",20)),4)))
Y <- c(0.19 , 0.22 , 0.23 , 0.17 , 0.36 , 0.33 , 0.30 , 0.39 , 0.35 , 0.27 , 0.20 , 0.22 , 0.24 , 0.16 , 0.36 , 0.30 , 0.31 , 0.39 , 0.33 , 0.25 , 0.23 , 0.13 , 0.16 , 0.18 ,  0.20 , 0.16 , 0.15 , 0.09 , 0.18 , 0.21 , 0.20 , 0.14 , 0.17 , 0.18 , 0.22 , 0.16 , 0.14 , 0.11 , 0.18 , 0.21 , 0.30 , 0.36 , 0.40 , 0.42 , 0.26 , 0.23 , 0.25 , 0.30 ,  0.27 , 0.15 , 0.29 , 0.36 , 0.38 , 0.42 , 0.28 , 0.23 , 0.26 , 0.29 , 0.24 , 0.17 , 0.24 , 0.14 , 0.17 , 0.16 , 0.15 , 0.21 , 0.19 , 0.15 , 0.16 , 0.13 , 0.25 , 0.12 ,  0.15 , 0.15 , 0.14 , 0.21 , 0.20 , 0.13 , 0.14 , 0.12 , 0.29 , 0.29 , 0.29 , 0.24 , 0.21 , 0.23 , 0.25 , 0.33 , 0.30 , 0.27 , 0.31 , 0.27 , 0.28 , 0.25 , 0.22 , 0.23 , 0.23 , 0.33 , 0.29 , 0.28 , 0.12 , 0.28 , 0.22 , 0.19 , 0.22 , 0.14 , 0.15 , 0.15 , 0.21 , 0.25 , 0.11 , 0.27 , 0.22 , 0.17 , 0.21 , 0.15 , 0.16 , 0.15 , 0.20 , 0.24 ,  0.24 , 0.25 , 0.36 , 0.24 , 0.34 , 0.22 , 0.27 , 0.26 , 0.23 , 0.28 , 0.24 , 0.23 , 0.36 , 0.23 , 0.35 , 0.21 , 0.25 , 0.26 , 0.23 , 0.28 , 0.24 , 0.23 , 0.09 , 0.16 , 0.16 , 0.14 , 0.18 , 0.18 , 0.18 , 0.12 , 0.22 , 0.23 , 0.09 , 0.17 , 0.15 , 0.13 , 0.17 , 0.19 , 0.17 , 0.11)
X <- factor(c(rep(c(rep("B1",10),rep("B2",10)),8)))
DATA=data.frame(Y,X,Z,Fc,Gp)
p <- qplot(X, Y, data=DATA, geom="boxplot", fill=Z, na.rm = TRUE, 
                    outlier.size = NA, outlier.colour = NA)  +
          facet_grid(Gp ~ Fc)+ theme_light()+scale_colour_gdocs()+
          theme(legend.position="bottom") + 
          stat_summary(fun.y=mean, geom="point", shape=23, position = position_dodge(width = .75))

我有以下内容：

我期望的图表是：

我尝试过这个方法：

p + stat_summary(fun.y=mean, geom="line", aes(group = factor(Z)))

并且这个

p + stat_summary(fun.y=mean, geom="line", aes(group = factor(X)))

但是以上方法都没有奏效。相反，我收到了以下错误提示信息：

geom_path: 每个组仅包含一个观察值。您是否需要调整组的美学风格？ geom_path: 每个组仅包含一个观察值。您是否需要调整组的美学风格？ geom_path: 每个组仅包含一个观察值。您是否需要调整组的美学风格？ geom_path: 每个组仅包含一个观察值。您是否需要调整组的美学风格？

感谢您的帮助！

- Ph.D.Student

Answer 1

这里有一个替代方案：

DATA$U <- paste(X, Z) # Extra interaction
qplot(U, Y, data = DATA, geom = "boxplot", fill = Z, na.rm = TRUE, 
      outlier.size = NA, outlier.colour = NA) +
  facet_grid(Gp ~ Fc) + theme_light() + scale_colour_gdocs() +
  theme(legend.position = "bottom") + 
  stat_summary(fun.y = mean, geom = "point", shape = 23, position = position_dodge(width = .75)) +
  stat_summary(fun.y = mean, geom = "line", aes(group = X)) + # Lines
  scale_x_discrete(labels = rep(levels(X), each = 2)) + xlab("X") # Some fixes

- Julius Vainora

---

很好的替代方案！但是在x轴上，我只想有B1和B2，不要有B1 B1和B2 B2，我的意思是，我想将B1和B2的箱线图分组，就像我在问题中发布的那样。谢谢你的帮助！ - Ph.D.Student

@Sh.student，我理解你的想法，但不幸的是这种方法会带来副作用。 - Julius Vainora

@Sh.student，https://dev59.com/l5Xfa4cB1Zd3GeqPfHXP 几乎是一个重复的问题，第二个答案提供了更多关于我的方法的细节。 - Julius Vainora

Answer 2

这并不优雅，但可以尝试这样做。

tmp1 = aggregate(Y~., DATA[DATA$Z == 100,], mean)
tmp2 = aggregate(Y~., DATA[DATA$Z == 50,], mean)
tmp1$X2 = tmp2$X
tmp1$Y2 = tmp2$Y

graphics.off()
ggplot(DATA, aes(x = factor(X), y = Y, fill = Z)) +
    geom_boxplot(width = 0.5, outlier.shape = NA) +
    geom_segment(data = tmp1,
                 aes(x = as.numeric(factor(X)) - 0.125, y = Y,
                     xend = as.numeric(factor(X2)) + 0.125, yend = Y2)) +
    facet_grid(Gp ~ Fc)

- d.b

Answer 3

你也可以尝试使用tidyverse解决方案：

library(tidyverse)
DATA %>% 
   ggplot() + 
   geom_boxplot(aes(X, Y, fill=Z)) +
   stat_summary(aes(X, Y,fill=Z),fun.y = mean, geom = "point",
                position=position_nudge(x=c(-0.185,0.185))) +
   geom_segment(data=. %>%
                  group_by(X, Z, Gp , Fc) %>% 
                  summarise(M=mean(Y)) %>% 
                  ungroup() %>% 
                  mutate(Z=paste0("C",Z)) %>% 
                  spread(Z, M), aes(x = as.numeric(X)-0.185, y = C100, 
                    xend = as.numeric(X)+0.185, yend = C50)) +
   facet_grid(Gp ~ Fc)

这个想法与d.b.的答案相同。为geom_segment调用创建一个数据框，优点是使用dplyr工作流程，因此一切都可以在一次运行中完成。

DATA %>% 
  group_by(X, Z, Gp , Fc) %>% 
  summarise(M=mean(Y)) %>% 
  ungroup() %>% 
  mutate(Z=paste0("C",Z)) %>% 
  spread(Z, M) 
# A tibble: 8 x 5
       X     Gp     Fc  C100   C50
* <fctr> <fctr> <fctr> <dbl> <dbl>
1     B1     G1    FC1 0.169 0.281
2     B1     G1    FC2 0.170 0.294
3     B1     G2    FC1 0.193 0.270
4     B1     G2    FC2 0.168 0.269
5     B2     G1    FC1 0.171 0.276
6     B2     G1    FC2 0.161 0.292
7     B2     G2    FC1 0.188 0.269
8     B2     G2    FC2 0.163 0.264

或者您可以尝试与Julius的答案略有不同的方法。添加断点和标签以获得预期的输出，并在数值X2上进行一些偏移，并在boxplot函数中使用宽度参数以使框绘制在一起。

DATA %>% 
  mutate(X2=as.numeric(interaction(Z, X))) %>% 
  mutate(X2=ifelse(Z==100, X2 + 0.2, X2 - 0.2)) %>% 
  ggplot(aes(X2, Y, fill=Z, group=X2)) + 
   geom_boxplot(width=0.6) +
   stat_summary(fun.y = mean, geom = "point") +
   stat_summary(aes(group = X),fun.y = mean, geom = "line") +
   facet_grid(Gp ~ Fc) +
   scale_x_continuous(breaks = c(1.5,3.5), labels = c("B1","B2"),
                        minor_breaks = NULL, limits=c(0.5,4.5))

- Roman

---

谢谢 @Jimbou 的帮助和清晰的答案！但我不明白为什么你要加上 X2+0.2 和 X2-0.2，以及 breaks=c(1.5,3.5)？ - Ph.D.Student

breaks = c(1.5, 3.5)被设置为您想要B1和B2的分组箱线图。因此，这是中间值。选择+/-0.2的偏移量以及width=0.6是因为F100和F50的箱子可以紧密地并排绘制。 - Roman

@Sh.student 忽略 scale_x_continuous 部分，那么就很清楚了。 - Roman

使用您的代码，我们能否消除或不显示异常值？例如使用：outlier.size = NA，outlier.colour = NA... - Ph.D.Student

当然可以。在箱线图函数中添加 outlier.color = NA。 - Roman

让我们在聊天中继续这个讨论。 - Ph.D.Student

Answer 4

另一种方法，可能有些复杂，但希望它避免了一些硬编码。

思路是构建一个包括stat_summary调用的绘图对象。然后从中获取相关数据(ggplot_build(p)$data[[2]])以用于连线。第二个数据部分([[2]])对应于绘图调用中的第二层，即由stat_summary生成的x和y。

获取面板(PANEL)和x类别(group)的x和y位置和索引。

在来自绘图对象的数据中，'PANEL'和'group'变量不是显式地以它们的名称给出，而是作为对不同组合的facet变量和最终将生成数字x位置(这里同时包括“真正”的x和fill)的变量的数字。然而，因为在ggplot中，分类变量按字典顺序排序，我们可以将数字与其对应的变量匹配。在这里，data.table中的.GRP函数很方便。

然后，可以使用这些数据在均值之间绘制geom_line。

# dodge value
pos <- position_dodge(width = 0.75)

# initial plot
p <- ggplot(data = DATA, aes(x = X, y = Y, fill = Z)) +
  geom_boxplot(outlier.size = NA, outlier.colour = NA, 
               position = pos) +
  stat_summary(fun.y = mean, geom = "point", shape = 23, position = pos) +
  facet_grid(Gp ~ Fc)

# grab relevant data
d <- ggplot_build(p)$data[[2]][ , c("PANEL", "group", "x", "y")]

library(data.table)
setDT(DATA)

# select unique combinations of facet and x variables
# here x includes the fill variable 'Z'
d2 <- unique(DATA[ , .(Gp, Fc, Z, X)])

# numeric index of facet combinations
d2[ , PANEL := .GRP, by = .(Gp, Fc)]

# numeric index of x combinations
d2[ , group := .GRP, by = .(Z, X)]

# add x and y positions by joining on PANEL and group
d2 <- d2[d, on = .(PANEL, group)]

# plot!
p + geom_line(data = d2, aes(x = x, y = y))

- Henrik

Answer 5

我有一种做法，与已经完成的方式相似，但是使用了geom_line、position_dodge和data.table。

library(data.table)
DATA=data.table(Y,X,Z,Fc,Gp)

 qplot(X, Y, data=DATA, geom="boxplot", fill=Z, na.rm = TRUE, 
           outlier.size = NA, outlier.colour = NA)  +
   geom_line(data = DATA[,list(Y = mean(Y)), by = .(X,Z,Fc,Gp)][X == "B1"],aes(X,Y,color = Z),group =1, position = position_dodge(width = .75),color = "black") +
   geom_line(data = DATA[,list(Y = mean(Y)), by = .(X,Z,Fc,Gp)][X == "B2"],aes(X,Y,color = Z),group =1, position = position_dodge(width = .75),color = "black") +
  facet_grid(Gp ~ Fc)+ theme_light()+
  theme(legend.position="bottom") +
  stat_summary(fun.y=mean, geom="point", shape=23, position = position_dodge(width = .75))

- denis