如何在R中使用facet_wrap对其上界和下界进行ggplot绘制？

Question

我正在尝试使用ggplot和facet_wrap功能来自动化绘制数据的过程。我想要一个y-axis标签，而不是单个图Ob（即A_Ob，B_ob等），也想要一个X-axis，而不是所有带有x-axis标签的图，如下所示。下面是我使用gridextra包的示例代码。但是，我想通过facet_wrap进行此操作，因为我还有许多其他绘图要绘制，我认为这可以节省一些时间。

graphics.off()
rm(list = ls())

library(tidyverse)
library(gridExtra)

G1 = data.frame(A_Ob = runif(1000, 5, 50), A_Sim = runif(1000, 3,60), A_upper = runif(1000, 10,70), A_lower = runif(1000, 0, 45 ),
                B_Ob = runif(1000, 5, 50), B_Sim = runif(1000, 3,60), B_upper = runif(1000, 10,70), B_lower = runif(1000, 0, 45 ),
                C_Ob = runif(1000, 5, 50), C_Sim = runif(1000, 3,60), C_upper = runif(1000, 10,70), C_lower = runif(1000, 0, 45 ),
                D_Ob = runif(1000, 5, 50), D_Sim = runif(1000, 3,60), D_upper = runif(1000, 10,70), D_lower = runif(1000, 0, 45 ),
                Pos = 1:1000)

A1 = ggplot(data = G1, aes(x = Pos))+
  geom_line(aes(y = A_Ob), col = "black")+
  geom_line(aes(y = A_Sim), col = "blue")+
  geom_vline(xintercept = 750,  color = "red", size=1.5)+
  geom_ribbon(aes(ymin = A_upper, ymax = A_lower), fill = "grey70")

B1 = ggplot(data = G1, aes(x = Pos))+
  geom_line(aes(y = B_Ob), col = "black")+
  geom_line(aes(y = B_Sim), col = "blue")+
  geom_vline(xintercept = 750,  color = "red", size=1.5)+
  geom_ribbon(aes(ymin = B_upper, ymax = B_lower), fill = "grey70")

C1 = ggplot(data = G1, aes(x = Pos))+
  geom_line(aes(y = C_Ob), col = "black")+
  geom_line(aes(y = C_Sim), col = "blue")+
  geom_vline(xintercept = 750,  color = "red", size=1.5)+
  geom_ribbon(aes(ymin = C_upper, ymax = C_lower), fill = "grey70")

D1 = ggplot(data = G1, aes(x = Pos))+
  geom_line(aes(y = D_Ob), col = "black")+
  geom_line(aes(y = D_Sim), col = "blue")+
  geom_vline(xintercept = 750,  color = "red", size=1.5)+
  geom_ribbon(aes(ymin = D_upper, ymax = D_lower), fill = "grey70")

grid.arrange(A1,B1,C1,D1, nrow = 4)

这里是代码的结果

Answer 1

您需要将数据框重整形为更长的格式，并分别将Ob，Sim，upper和lower的值分开。

使用melt程序包中的data.table功能可以帮助您实现这一目标：

library(data.table)
setDT(G1)
Ob_cols = grep("_Ob",colnames(G1),value = TRUE)
Sim_cols = grep("_Sim",colnames(G1),value = TRUE)
Upper_cols = grep("_upper",colnames(G1), value = TRUE)
Lower_cols = grep("_lower", colnames(G1), value = TRUE)
g.m <- melt(G1, measure = list(Ob_cols,Sim_cols,Upper_cols,Lower_cols), value.name = c("OBS","SIM","UP","LOW"))

levels(g.m$variable) <- c("A","B","C","D") 

   Pos variable       OBS       SIM       UP      LOW
1:   1        A  5.965488 29.167666 26.66783 29.97259
2:   2        A 23.855719  8.570245 43.75830 30.65616
3:   3        A 16.947887 51.201047 15.20758 39.76122
4:   4        A 49.883306  3.715319 34.38066 20.73177
5:   5        A  5.021938  3.102880 30.05036 32.05123
6:   6        A 19.887176 15.400853 53.67156 28.54982

现在，您可以绘制它：

library(ggplot2)
ggplot(g.m, aes(x = Pos))+
  geom_line(aes(y = OBS), color = "black")+
  geom_line(aes(y = SIM), color = "blue")+
  geom_vline(xintercept = 750,color = "red", size = 1.5)+
  geom_ribbon(aes(ymin = UP, ymax = LOW), fill = "grey70")+
  facet_grid(variable~.)

编辑：添加注释和重命名标签

要重命名和替换构面标签，您可以重新定义variable的级别，并以facet_wrap作为参数，使用facet_grid代替ncol = 1。

要在单个面板上添加多个注释，您需要定义将在geom_text中使用的数据框。

总共，您必须做：

# renaming names of each facets:
levels(g.m$variable) <- c("M1","M2","M3","M4")

# Defining annotations to add:
df_text <- data.frame(label = c("Calibration", "Validation"),
                       x = c(740,760),
                       y = c(65,65),
                       hjust = c(1,0),
                       variable = factor("M1", levels = c("M1","M2","M3","M4")))

# Plotting
ggplot(g.m, aes(x = Pos))+
  geom_line(aes(y = OBS), color = "black")+
  geom_line(aes(y = SIM), color = "blue")+
  geom_vline(xintercept = 750,color = "red", size = 1.5)+
  geom_ribbon(aes(ymin = UP, ymax = LOW), fill = "grey70")+
  facet_wrap(variable~., ncol = 1)+
  theme(strip.text.x = element_text(hjust = 0),
        strip.background = element_rect(fill = "white"))+
  geom_text(data = df_text, aes(x = x, y = y, label = label, hjust = hjust), color = "red")

看起来像您期望的那样吗？