为 ggplot 2.2.0 破坏的 gtable_add_grob 代码寻求解决方法

Seeking workaround for gtable_add_grob code broken by ggplot 2.2.0

在具有多个方面变量的图中,ggplot2 重复 "outer" 变量的方面标签,而不是在 "inner" 变量的所有级别上使用单个跨越方面条带。我有一些代码,我一直使用这些代码使用 gtable 包中的 gtable_add_grob 用单个跨越小平面条覆盖重复的外小平面标签。

不幸的是,由于刻面条的 grob 结构发生了变化,此代码不再适用于 ggplot2 2.2.0。具体来说,在以前版本的 ggplot2 中,每行刻面标签都有自己的一组 grob。然而,在版本 2.2.0 中,每个垂直堆叠的分面标签看起来都是一个单一的 grob。这破坏了我的代码,我不确定如何修复它。

这是一个具体的例子,取自an SO question I answered a few months ago

# Data
df = structure(list(location = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 
    1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 1L, 1L, 
    1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 
    2L, 2L), .Label = c("SF", "SS"), class = "factor"), species = structure(c(1L, 
    1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
    1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 
    2L, 2L, 2L, 2L, 2L, 2L, 2L), .Label = c("AGR", "LKA"), class = "factor"), 
        position = structure(c(1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 
        2L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 
        1L, 2L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 
        2L), .Label = c("top", "bottom"), class = "factor"), density = c(0.41, 
        0.41, 0.43, 0.33, 0.35, 0.43, 0.34, 0.46, 0.32, 0.32, 0.4, 
        0.4, 0.45, 0.34, 0.39, 0.39, 0.31, 0.38, 0.48, 0.3, 0.42, 
        0.34, 0.35, 0.4, 0.38, 0.42, 0.36, 0.34, 0.46, 0.38, 0.36, 
        0.39, 0.38, 0.39, 0.39, 0.39, 0.36, 0.39, 0.51, 0.38)), .Names = c("location", 
    "species", "position", "density"), row.names = c(NA, -40L), class = "data.frame")

# Begin with a regular ggplot with three facet levels
p=ggplot(df, aes("", density)) + 
  geom_boxplot(width=0.7, position=position_dodge(0.7)) + 
  theme_bw() +
  facet_grid(. ~ species + location +  position) +
  theme(panel.margin=unit(0,"lines"),
        strip.background=element_rect(color="grey30", fill="grey90"),
        panel.border=element_rect(color="grey90"),
        axis.ticks.x=element_blank()) +
  labs(x="")

我们从一个具有三个层面的图开始。

现在我们将用跨越条带覆盖顶部的两个面条带,这样我们就没有重复的条带标签:

pg = ggplotGrob(p)

# Add spanning strip labels for species
pos = c(4,11)    
for (i in 1:2) {
  pg <- gtable_add_grob(pg, 
                        list(rectGrob(gp=gpar(col="grey50", fill="grey90")),
                             textGrob(unique(densityAGRLKA$species)[i], 
                                      gp=gpar(cex=0.8))), t=3,l=pos[i],b=3,r=pos[i]+7,
                        name=c("a","b"))
}

# Add spanning strip labels for location
pos=c(4,7,11,15)
for (i in 1:4) {
    pg = gtable_add_grob(pg, 
                         list(rectGrob(gp = gpar(col="grey50", fill="grey90")),
                              textGrob(rep(unique(densityAGRLKA$location),2)[i], 
                                       gp=gpar(cex=0.8))), t=4,l=pos[i],b=4,r=pos[i]+3, 
                         name = c("c","d"))
}

grid.draw(pg)

这是使用 ggplot2 2.1.0 时该图的样子:

但是,如果我在 ggplot2 2.2.0 上尝试使用相同的代码,我会得到原始图,条带标签没有任何变化。查看原始图 p 的 grob 结构可以看出为什么会发生这种情况。我已经粘贴在这个问题底部的 grob 表中。为了节省 space,我只包含了与小平面相关的行。

查看 cells 列,请注意,在 2.1.0 版本的绘图中,每行中的前两个数字是 3、4 或 5,表示 grob 相对的垂直位置给情节中的其他人。在上面的代码中,gtable_add_grobtl 参数设置为 3 或 4 的值,因为这些是我想用跨越条带覆盖的小平面条带行。

现在查看 2.2.0 版绘图中的 cells 列:请注意,前两个数字始终为 6。还要注意,面条仅由 8 个 grob 组成,而不是 24 个在版本 2.1.0 中。在 2.2.0 版中,似乎每三个面标签的堆栈现在是一个单一的 grob,而不是三个单独的 grob。因此,即使我将 gtable_add_grob 中的 tb 参数更改为 6,也会覆盖所有三个面条。这是一个例子:

pg = ggplotGrob(p)

# Add spanning strip labels for species
pos = c(4,11)    
for (i in 1:2) {
  pg <- gtable_add_grob(pg, 
                        list(rectGrob(gp=gpar(col="grey50", fill="grey90")),
                             textGrob(unique(densityAGRLKA$species)[i], 
                                      gp=gpar(cex=0.8))), t=6,l=pos[i],b=6,r=pos[i]+7,
                        name=c("a","b"))
}

所以,在冗长的介绍之后,这是我的问题:如何使用 ggplot2 2.2.0 版创建跨越小平面条带,使其看起来像我使用 gtable_add_grob 和 ggplot2 2.1 版创建的那些。 0?我希望有一个简单的调整,但如果它需要大手术,那也没关系。

ggplot 2.1.0

pg
TableGrob (9 x 19) "layout": 45 grobs
    z         cells       name                                   grob
2   1 ( 3- 3, 4- 4)  strip-top   absoluteGrob[strip.absoluteGrob.147]
3   2 ( 4- 4, 4- 4)  strip-top   absoluteGrob[strip.absoluteGrob.195]
4   3 ( 5- 5, 4- 4)  strip-top   absoluteGrob[strip.absoluteGrob.243]
5   4 ( 3- 3, 6- 6)  strip-top   absoluteGrob[strip.absoluteGrob.153]
6   5 ( 4- 4, 6- 6)  strip-top   absoluteGrob[strip.absoluteGrob.201]
7   6 ( 5- 5, 6- 6)  strip-top   absoluteGrob[strip.absoluteGrob.249]
8   7 ( 3- 3, 8- 8)  strip-top   absoluteGrob[strip.absoluteGrob.159]
9   8 ( 4- 4, 8- 8)  strip-top   absoluteGrob[strip.absoluteGrob.207]
10  9 ( 5- 5, 8- 8)  strip-top   absoluteGrob[strip.absoluteGrob.255]
11 10 ( 3- 3,10-10)  strip-top   absoluteGrob[strip.absoluteGrob.165]
12 11 ( 4- 4,10-10)  strip-top   absoluteGrob[strip.absoluteGrob.213]
13 12 ( 5- 5,10-10)  strip-top   absoluteGrob[strip.absoluteGrob.261]
14 13 ( 3- 3,12-12)  strip-top   absoluteGrob[strip.absoluteGrob.171]
15 14 ( 4- 4,12-12)  strip-top   absoluteGrob[strip.absoluteGrob.219]
16 15 ( 5- 5,12-12)  strip-top   absoluteGrob[strip.absoluteGrob.267]
17 16 ( 3- 3,14-14)  strip-top   absoluteGrob[strip.absoluteGrob.177]
18 17 ( 4- 4,14-14)  strip-top   absoluteGrob[strip.absoluteGrob.225]
19 18 ( 5- 5,14-14)  strip-top   absoluteGrob[strip.absoluteGrob.273]
20 19 ( 3- 3,16-16)  strip-top   absoluteGrob[strip.absoluteGrob.183]
21 20 ( 4- 4,16-16)  strip-top   absoluteGrob[strip.absoluteGrob.231]
22 21 ( 5- 5,16-16)  strip-top   absoluteGrob[strip.absoluteGrob.279]
23 22 ( 3- 3,18-18)  strip-top   absoluteGrob[strip.absoluteGrob.189]
24 23 ( 4- 4,18-18)  strip-top   absoluteGrob[strip.absoluteGrob.237]
25 24 ( 5- 5,18-18)  strip-top   absoluteGrob[strip.absoluteGrob.285]

ggplot2 2.2.0

pg
TableGrob (11 x 21) "layout": 42 grobs
    z         cells       name                                    grob
28  2 ( 6- 6, 4- 4)  strip-t-1                           gtable[strip]
29  2 ( 6- 6, 6- 6)  strip-t-2                           gtable[strip]
30  2 ( 6- 6, 8- 8)  strip-t-3                           gtable[strip]
31  2 ( 6- 6,10-10)  strip-t-4                           gtable[strip]
32  2 ( 6- 6,12-12)  strip-t-5                           gtable[strip]
33  2 ( 6- 6,14-14)  strip-t-6                           gtable[strip]
34  2 ( 6- 6,16-16)  strip-t-7                           gtable[strip]
35  2 ( 6- 6,18-18)  strip-t-8                           gtable[strip]

确实,ggplot2 v2.2.0 逐列构造复杂的条带,每列一个 grob。这可以通过提取一条,然后检查其结构来检查。使用你的情节:

library(ggplot2)
library(gtable)
library(grid)

# Your data
df = structure(list(location = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 
 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 1L, 1L, 
 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 
 2L, 2L), .Label = c("SF", "SS"), class = "factor"), species = structure(c(1L, 
 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 
 2L, 2L, 2L, 2L, 2L, 2L, 2L), .Label = c("AGR", "LKA"), class = "factor"), 
    position = structure(c(1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 
    2L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 
    1L, 2L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 
    2L), .Label = c("top", "bottom"), class = "factor"), density = c(0.41, 
    0.41, 0.43, 0.33, 0.35, 0.43, 0.34, 0.46, 0.32, 0.32, 0.4, 
    0.4, 0.45, 0.34, 0.39, 0.39, 0.31, 0.38, 0.48, 0.3, 0.42, 
    0.34, 0.35, 0.4, 0.38, 0.42, 0.36, 0.34, 0.46, 0.38, 0.36, 
    0.39, 0.38, 0.39, 0.39, 0.39, 0.36, 0.39, 0.51, 0.38)), .Names = c("location", 
   "species", "position", "density"), row.names = c(NA, -40L), class = "data.frame")

# Your ggplot with three facet levels
p=ggplot(df, aes("", density)) + 
  geom_boxplot(width=0.7, position=position_dodge(0.7)) + 
  theme_bw() +
  facet_grid(. ~ species + location +  position) +
  theme(panel.spacing=unit(0,"lines"),
     strip.background=element_rect(color="grey30", fill="grey90"),
     panel.border=element_rect(color="grey90"),
     axis.ticks.x=element_blank()) +
  labs(x="")

# Get the ggplot grob
pg = ggplotGrob(p)

# Get the left most strip
index = which(pg$layout$name == "strip-t-1")
strip1 = pg$grobs[[index]]

# Draw the strip
grid.newpage()
grid.draw(strip1)

# Examine its layout
strip1$layout
gtable_show_layout(strip1)

获取外部条带标签 'spanning' 内部标签的一种粗略方法是从头开始构建条带:

# Get the strips, as a list, from the original plot
strip = list()
for(i in 1:8) {
   index = which(pg$layout$name == paste0("strip-t-",i))
   strip[[i]] = pg$grobs[[index]]
}

# Construct gtable to contain the new strip
newStrip  = gtable(widths = unit(rep(1, 8), "null"), heights = strip[[1]]$heights)

## Populate the gtable    
# Top row
for(i in 1:2) {
   newStrip = gtable_add_grob(newStrip, strip[[4*i-3]][1], 
           t = 1, l = 4*i-3, r = 4*i)
}

# Middle row
for(i in 1:4){
   newStrip = gtable_add_grob(newStrip, strip[[2*i-1]][2], 
         t = 2, l = 2*i-1, r = 2*i)
}

# Bottom row
for(i in 1:8) {
   newStrip = gtable_add_grob(newStrip, strip[[i]][3], 
       t = 3, l = i)
}

# Put the strip into the plot 
# (It could be better to remove the original strip. 
# In this case, with a coloured background, it doesn't matter)
pgNew = gtable_add_grob(pg, newStrip, t = 7, l = 5, r = 19)

# Draw the plot
grid.newpage()
grid.draw(pgNew)

OR 使用矢量化 gtable_add_grob(见评论):

pg = ggplotGrob(p)

# Get a list of strips from the original plot
strip = lapply(grep("strip-t", pg$layout$name), function(x) {pg$grobs[[x]]})

# Construct gtable to contain the new strip
newStrip  = gtable(widths = unit(rep(1, 8), "null"), heights = strip[[1]]$heights)

## Populate the gtable    
# Top row
cols = seq(1, by = 4, length.out = 2)
newStrip = gtable_add_grob(newStrip, lapply(strip[cols], `[`, 1), t = 1, l = cols, r = cols + 3)

# Middle row
cols = seq(1, by = 2, length.out = 4)
newStrip = gtable_add_grob(newStrip, lapply(strip[cols], `[`, 2), t = 2, l = cols, r = cols + 1)

# Bottom row
newStrip = gtable_add_grob(newStrip, lapply(strip, `[`, 3), t = 3, l = 1:8)

# Put the strip into the plot
pgNew = gtable_add_grob(pg, newStrip, t = 7, l = 5, r = 19)

# Draw the plot
grid.newpage()
grid.draw(pgNew)

编辑允许不同宽度的面板(即scales = "free_x"space = "free_x")。

这次尝试采用原始 ggplot,提取一些信息,然后构建一个包含重叠条带的新 grob。该功能不是很漂亮,但是可以使用……到目前为止。它需要安装 plyr

library(ggplot2)
library(grid)
library(gtable)


df = structure(list(location = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 
    1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 1L, 1L, 
    1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 
    2L, 2L), .Label = c("SF", "SS"), class = "factor"), species = structure(c(1L, 
    1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
    1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 
    2L, 2L, 2L, 2L, 2L, 2L, 2L), .Label = c("AGR", "LKA"), class = "factor"), 
        position = structure(c(1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 
        2L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 
        1L, 2L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 
        2L), .Label = c("top", "bottom"), class = "factor"), density = c(0.41, 
        0.41, 0.43, 0.33, 0.35, 0.43, 0.34, 0.46, 0.32, 0.32, 0.4, 
        0.4, 0.45, 0.34, 0.39, 0.39, 0.31, 0.38, 0.48, 0.3, 0.42, 
        0.34, 0.35, 0.4, 0.38, 0.42, 0.36, 0.34, 0.46, 0.38, 0.36, 
        0.39, 0.38, 0.39, 0.39, 0.39, 0.36, 0.39, 0.51, 0.38)), .Names = c("location", 
    "species", "position", "density"), row.names = c(NA, -40L), class = "data.frame")

# Begin with a regular ggplot with three facet levels
p=ggplot(df, aes("", density)) + 
  geom_boxplot(width=0.7, position=position_dodge(0.7)) + 
  theme_bw() +
  facet_grid(. ~ species + location + position) +
  theme(panel.spacing=unit(0,"lines"),
        strip.background=element_rect(color="grey30", fill="grey90"),
        panel.border=element_rect(color="grey90"),
        axis.ticks.x=element_blank()) +
  labs(x="")

## The function to get overlapping strip labels
OverlappingStripLabels = function(plot) {

# Get the ggplot grob
g = ggplotGrob(plot)

### Collect some information about the strips from the plot
# Get a list of strips
strip = lapply(grep("strip-t", g$layout$name), function(x) {g$grobs[[x]]})

# Number of strips
NumberOfStrips = sum(grepl(pattern = "strip-t", g$layout$name))

# Number of rows
NumberOfRows = length(strip[[1]])

# Panel spacing and it's unit
plot_theme <- function(p) {
   plyr::defaults(p$theme, theme_get())
}
PanelSpacing = plot_theme(plot)$panel.spacing
unit = attr(PanelSpacing, "unit")

# Map the boundaries of the new strips
Nlabel = vector("list", NumberOfRows)
map = vector("list", NumberOfRows)
for(i in 1:NumberOfRows) {

  for(j in 1:NumberOfStrips) {
   Nlabel[[i]][j] = getGrob(grid.force(strip[[j]][i]), gPath("GRID.text"), grep = TRUE)$label
  }

map[[i]][1] = TRUE
for(j in 2:NumberOfStrips) {
   map[[i]][j] = Nlabel[[i]][j] != Nlabel[[i]][j-1]
   }
}



## Construct gtable to contain the new strip
# Set the widths of the strips, based on widths of the panels and PanelSpacing
panel = subset(g$layout, grepl("panel", g$layout$name), l, drop = TRUE)                       
StripWidth = list()
for(i in seq_along(panel)) StripWidth[[i]] = unit.c(g$width[panel[i]], PanelSpacing)

newStrip  = gtable(widths = unit.c(unit(unlist(StripWidth), c("null", unit)))[-2*NumberOfStrips], 
                   heights = strip[[1]]$heights)


## Populate the gtable  
seqLeft = list()
for(i in 1:NumberOfRows) {  
   Left = which(map[[i]] == TRUE)
   seqLeft[[i]] = if((i-1) < 1) 2*Left - 1 else sort(unique(c(seqLeft[[i-1]], 2*Left - 1))) 
   seqRight = c(seqLeft[[i]][-1] -2, (2*NumberOfStrips-1))
   newStrip = gtable_add_grob(newStrip, lapply(strip[(seqLeft[[i]]+1)/2], `[`, i), t = i, l = seqLeft[[i]], r = seqRight)
}

## Put the strip into the plot
# Get the locations of the original strips
pos = subset(g$layout, grepl("strip-t", g$layout$name), t:r)

## Use these to position the new strip
pgNew = gtable_add_grob(g, newStrip, t = unique(pos$t), l = min(pos$l), r = max(pos$r))

return(pgNew)
}

## Draw the plot
grid.newpage()
grid.draw(OverlappingStripLabels(p))

打破这个功能可能不会太难,但我在行序不太均匀的数据上试过了。

p1 = ggplot(mtcars, aes("", hp)) + 
  geom_boxplot(width=0.7, position=position_dodge(0.7)) + 
  theme_bw() +
  facet_grid(. ~ vs + am + carb, labeller = label_both) +
  theme(panel.spacing=unit(0.2,"lines"),
        strip.background=element_rect(color="grey30", fill="grey90"),
        panel.border=element_rect(color="grey90"),
        axis.ticks.x=element_blank()) +
  labs(x="")

  grid.draw(OverlappingStripLabels(p1))

p2 = ggplot(mtcars, aes("", hp)) + 
  geom_boxplot(width=0.7, position=position_dodge(0.7)) + 
  theme_bw() +
  facet_grid(. ~ vs + carb +  am, labeller = label_both) +
  theme(panel.spacing=unit(0.2,"lines"),
        strip.background=element_rect(color="grey30", fill="grey90"),
        panel.border=element_rect(color="grey90"),
        axis.ticks.x=element_blank()) +
  labs(x="")

 grid.draw(OverlappingStripLabels(p2))




df = structure(list(id = 1:19, 
category1 = c("X", "X", "X", "X", "X", "X", "X", "X", "X", "Y", "Y", "Y", "Y", "Y", "Y", "Y", "Y", "Y", "Y"),
category2 = c(21L, 21L, 21L, 22L, 22L, 22L, 22L, 22L, 22L, 23L, 23L, 23L, 24L, 24L, 24L, 25L, 25L, 26L, 26L), 
category3 = c("C1", "C2", "C3", "D1", "D2", "D3", "D5", "D6", "D7", "E1", "E2", "E3", "F1", "F2", "F3", "G1", "G2", "H1", "H2"), 
freq = c(4L, 7L, 4L, 28L, 20L, 0L, 1L, 4L, 1L, 17L, 33L, 31L, 20L, 20L, 21L, 15L, 18L, 12L, 13L)), 
.Names = c("id", "category1", "category2", "category3", "freq"), class = "data.frame", row.names = c(NA, -19L))

p3 = ggplot(df, aes(category3, freq)) + 
  geom_bar(stat = "identity") + 
  facet_grid(. ~ category1 + category2, scale = "free_x", space = "free_x")

 grid.draw(OverlappingStripLabels(p3))