facet_wrap中的多个标题（ggplot2）

Question

我试图使用facet_wrap和ggplot2向图形中添加多个标题。假设您有两年的季度数据，并想对季度数据进行图形比较，其中包括两个重要的标题：2014年和2015年，以及各自季度的标题。

到目前为止，我已经做到了这一点：

data <- rnorm(10)

A1 <- data.frame("Y"=data, "X"=1:10, "Q"=1, "year"=2014)
A2 <- data.frame("Y"=data, "X"=1:10, "Q"=2, "year"=2014)
A3 <- data.frame("Y"=data, "X"=1:10, "Q"=3, "year"=2014)
A4 <- data.frame("Y"=data, "X"=1:10, "Q"=4, "year"=2014)

N1 <- data.frame("Y"=data, "X"=1:10, "Q"=1, "year"=2015)
N2 <- data.frame("Y"=data, "X"=1:10, "Q"=2, "year"=2015)
N3 <- data.frame("Y"=data, "X"=1:10, "Q"=3, "year"=2015)
N4 <- data.frame("Y"=data, "X"=1:10, "Q"=4, "year"=2015)

A <- rbind(A1, A2, A3, A4)
N <- rbind(N1, N2, N3, N4)
tmp <- data.frame(rbind(A, N))

ggplot(data=tmp, aes(x=X, y=Y)) + geom_line() + facet_wrap(~year + Q, scales="free", ncol=4)

它为我提供了这个图表：

相反，我想让“2014”和“2015”分别位于每个子图上方的两个独立的灰色框中。 是否可能做到这一点？

谢谢！

- Pierre

---

也许可以在这里看到：https://dev59.com/Fmgt5IYBdhLWcg3w7BkE - MichaelChirico

这里可能会有帮助：链接1，或者链接2。 - Sandy Muspratt

Answer 1

使用这里的代码，正如Sandy Muspratt所建议的那样，我可以得出：

library(ggplot2)
library(gtable)

data <- rnorm(10)

A1 <- data.frame("Y"=data, "X"=1:10, "Q"=1, "year"=2014)
A2 <- data.frame("Y"=data, "X"=1:10, "Q"=2, "year"=2014)
A3 <- data.frame("Y"=data, "X"=1:10, "Q"=3, "year"=2014)
A4 <- data.frame("Y"=data, "X"=1:10, "Q"=4, "year"=2014)

N1 <- data.frame("Y"=data, "X"=1:10, "Q"=1, "year"=2015)
N2 <- data.frame("Y"=data, "X"=1:10, "Q"=2, "year"=2015)
N3 <- data.frame("Y"=data, "X"=1:10, "Q"=3, "year"=2015)
N4 <- data.frame("Y"=data, "X"=1:10, "Q"=4, "year"=2015)

A <- rbind(A1, A2, A3, A4)
N <- rbind(N1, N2, N3, N4)
tmp <- data.frame(rbind(A, N))

p <- ggplot(data=tmp, aes(x=X, y=Y)) + geom_line() + facet_wrap(~year + Q, scales="free", ncol=4)


z <- ggplotGrob(p)

#  New title strip at the top
z <- gtable_add_rows(z, unit(1, "lines"), pos = 0)  # New row added to top

# Display the layout to select the place for the new strip
gtable_show_layout(z)   # New strip goes into row 2 
# New strip spans columns 4 to 13

z <- gtable_add_grob(z, 
                     list(rectGrob(gp = gpar(col = NA, fill = grey(0.8), size = .5)),
                          textGrob("2014", vjust = .27, 
                                   gp = gpar(cex = .75, fontface = 'bold', col = "black"))), 2, 4, 2, 13, name = c("a", "b"))

# Add small gap between strips - below row 2
z <- gtable_add_rows(z, unit(2/10, "line"), 2)


#  New title strip in the middle
z <- gtable_add_rows(z, unit(1, "lines"), pos = 8)  # New row added to top
# Display the layout to select the place for the new strip
gtable_show_layout(z) 
# New strip goes into row 9 
# New strip spans columns 4 to 13

z <- gtable_add_grob(z, 
                     list(rectGrob(gp = gpar(col = NA, fill = grey(0.8), size = .5)),
                          textGrob("2015", vjust = .27, 
                                   gp = gpar(cex = .75, fontface = 'bold', col = "black"))), 9, 4, 9, 13, name = c("a", "b"))

# Add small gap between strips - below row 2
z <- gtable_add_rows(z, unit(2/10, "line"), 9)


# Draw it
grid.newpage()
grid.draw(z)

这将为您提供以下图表：

- RHA

Answer 2

你比我更快，RHA。在看到你的帖子之前，我写了几乎相同的代码。无论如何，谢谢！

我也想从灰色框中删除“2014”和“2015”（这是我在第一篇文章中没有指定的），所以我必须做出更多修改。

受到这里，这里和这里的启发，我编写了以下（非常丑陋的）代码：

data14 <- rnorm(10)
data15 <- rnorm(10, mean = 500)

A1 <- data.frame("Y"=data14, "X"=1:10, "Q"=1, "year"=2014)
A2 <- data.frame("Y"=data14, "X"=1:10, "Q"=2, "year"=2014)
A3 <- data.frame("Y"=data14, "X"=1:10, "Q"=3, "year"=2014)
A4 <- data.frame("Y"=data14, "X"=1:10, "Q"=4, "year"=2014)

N1 <- data.frame("Y"=data15, "X"=1:10, "Q"=1, "year"=2015)
N2 <- data.frame("Y"=data15, "X"=1:10, "Q"=2, "year"=2015)
N3 <- data.frame("Y"=data15, "X"=1:10, "Q"=3, "year"=2015)
N4 <- data.frame("Y"=data15, "X"=1:10, "Q"=4, "year"=2015)

A <- rbind(A1, A2, A3, A4)
N <- rbind(N1, N2, N3, N4)
tmp <- data.frame(rbind(A, N))

然后我编写了一个简单的函数并正确命名了变量。

labFunc <- function(data, var1, var2, names) {
  data$id <- NA
  loop <- length(levels(factor(data[[var2]])))

  for (i in 1:loop) {
    data[data[[var1]] == 2014 & data[[var2]] == levels(factor(data[[var2]]))[i], "id"] <- names[i]
    data[data[[var1]] == 2015 & data[[var2]] == levels(factor(data[[var2]]))[i], "id"] <- paste(names[i], "")
  }

  first <- levels(factor(data$id))[seq(from=1, to = length(levels(factor(data$id))), by = 2)]
  second <- levels(factor(data$id))[seq(from=2, to = length(levels(factor(data$id))), by = 2)]

  data$id <- factor(data$id, levels=paste(c(first, second)))
  return(data)
}

names <- c("Q1", "Q2", "Q3", "Q4")
data <- labFunc(tmp, "year", "Q", names)

制作情节：

p <-ggplot(data, aes(y = Y, x = X)) +
    geom_line() +
    facet_wrap( ~ id , ncol = 4, scales = "free")

最后添加主要标签。

z <- ggplotGrob(p)

#  New strip at the top
z <- gtable_add_rows(z, unit(1, "lines"), pos = 0)  # New row added to top
z <- gtable_add_rows(z, unit(1, "lines"), pos = 6)  # New row added to top

#z <- gtable_add_rows(z, unit(9, "lines"), pos = 0)  # New row added to top


# Check the layout
gtable_show_layout(z)   # New strip goes into row 2 
# New strip spans columns 4 to 8

z <- gtable_add_grob(z, 
                     list(rectGrob(gp = gpar(col = NA, fill = grey(0.8), size = .5)),
                          textGrob("2014", vjust = .27, 
                                   gp = gpar(cex = .75, fontface = 'bold', col = "black"))), 2, 4, 2, 14, name = c("a", "b"))

z <- gtable_add_grob(z, 
                     list(rectGrob(gp = gpar(col = NA, fill = grey(0.8), size = .5)),
                          textGrob("2015", vjust = .27, 
                                   gp = gpar(cex = .75, fontface = 'bold', col = "black"))), 7, 4, 7, 14, name = c("a", "b"))



# Add small gap between strips - below row 2
z <- gtable_add_rows(z, unit(2/10, "lines"), 2)
z <- gtable_add_rows(z, unit(5/10, "lines"), 7)

# Draw it
grid.newpage()
grid.draw(z)

这比我想象中要棘手一些，但感谢大家的帮助!

- Pierre