Поиск обходного пути для файла gtable_add_grob, нарушенного ggplot 2.2.0

Ответ 1

В самом деле, ggplot2 v2.2.0 строит комплексный столбец по столбцу, причем каждый столбец представляет собой один гун. Это можно проверить, извлекая одну полоску, а затем исследуя ее структуру. Используя ваш сюжет:

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)

Один из грубых способов получить метки внутренней полосы на внутренней этикетке - это построить полоску с нуля:

# 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 = 6, l = 4, r = 18)

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

ИЛИ с помощью векторизованного 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 = 6, l = 4, r = 18)

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

Ответ 2

Эта попытка берет оригинальный ggplot, извлекает некоторую информацию, затем конструирует новый гроб, содержащий перекрывающиеся полосы. Функция не очень красивая, но она работает... пока. Для этого требуется 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
plot_theme <- function(p) {
   plyr::defaults(p$theme, theme_get())
}
PanelSpacing = plot_theme(plot)$panel.spacing

# 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
newStrip  = gtable(widths = unit.c(rep(unit.c(unit(1, "null"), PanelSpacing), NumberOfStrips-1), unit(1, "null")), 
                   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))