R 在ggplot2刻面_包裹中跨列组合多个刻面条带

我试图在两个相邻的面板上组合镶嵌条（总是有两个相邻的镶嵌条具有相同的第一个ID变量，但有两个不同的场景，让我们称它们为“A”和“B”）。我并不特别喜欢我尝试过的

gtable

+

grid

解决方案，但遗憾的是，我无法使用

ggh4x

包中的

facet\u nested（）

（我无法在我公司的服务器上安装它，因为存在各种限制和所需的依赖关系-我只考虑了使用相关代码，但由于依赖关系，这同样不容易）

我希望通过组合顶部镶嵌条指示哪些面板“属于一起”，从而使基本图的最低可行示例更易于阅读，如下所示：

library(tidyverse)
library(gtable)
library(grid)

idx = 1:16

p1 = expand_grid(id=idx, id2=c("A", "B"), x=1:10) %>%
  mutate(y=rnorm(n=n())) %>%
  ggplot(aes(x=x,y=y)) +
  geom_jitter() +
  facet_wrap(~id + id2, nrow = 4, ncol=8)

带“1”的条带和带“2”的条带等应该组合在一起（事实上，这是一个较长的文本，但这只是为了说明）。我试图为类似的场景改编一个答案（-thank you@markus再次找到它），但这是我尝试过的。正如你在下面看到的，我制作的东西的高度似乎是错误的。我想这一定是我忽略了/不理解的一些小事

# Combine strips for a ID
g <- ggplot_gtable(ggplot_build(p1))
strip <- gtable_filter(g, "strip-t", trim = FALSE)
stript <- which(grepl('strip-t', g$layout$name))
  
stript2 = stript[idx*2-1]
top <- strip$layout$t[idx*2-1]
# # Using the $b below instead of b = top[i]+1, also seems  not to work
#bot <- strip$layout$b[idx*2-1] 
l   <- strip$layout$l[idx*2-1]
r   <- strip$layout$r[idx*2]
  
mat   <- matrix(vector("list",
                       length = length(idx)*3),
                nrow = length(idx))
mat[] <- list(zeroGrob())

res <- gtable_matrix("toprow", mat,
                     unit(c(1, 0, 1), "null"),
                     unit( rep(1, length(idx)),
                           "null"))

for (i in 1:length(stript2)){
  if (i==1){
    zz <- res %>% 
      gtable_add_grob(g$grobs[[stript2[i]]]$grobs[[1]], 1, 1, 1, 3) %>%
      gtable_add_grob(g, ., 
                      t = top[i],  
                      l = l[i],  
                      b = top[i]+1,  
                      r = r[i], 
                      name = c("add-strip")) 
  } else {
    zz <- res %>% 
      gtable_add_grob(g$grobs[[stript2[i]]]$grobs[[1]], 1, 1, 1, 3) %>%
      gtable_add_grob(zz, ., 
                      t = top[i],  
                      l = l[i],  
                      b = top[i]+1,  
                      r = r[i], 
                      name = c("add-strip"))
  } 
}

grid::grid.draw(zz)

---

也许这不能解决这个问题，但我想发布，因为它可以帮助在保持相同结构的不同绘图中显示结果。您必须在

plot\u布局（ncol=4）

中定义绘图的列数。此代码使用

修补程序包。希望这会有用

library(tidyverse)
library(gtable)
library(grid)
library(patchwork)

idx = 1:16

#Data

p1 = expand_grid(id=idx, id2=c("A", "B"), x=1:10) %>%
  mutate(y=rnorm(n=n()))

#Split data
List <- split(p1,p1$id)
#Sketch function
myplot <- function(x)
{
  d <- ggplot(x,aes(x=x,y=y)) +
    geom_jitter() +
    facet_wrap(~id2, nrow = 1, ncol=2)+
    ggtitle(unique(x$id))+
    theme(plot.title = element_text(hjust = 0.5))
  return(d)
}

#List of plots
Lplots <- lapply(List,myplot)
#Concatenate plots
#Create chain for plots
chain <- paste0('Lplots[[',1:length(Lplots),']]',collapse = '+')
#Evaluate the object and create the plot
Plot <- eval(parse(text = chain))+plot_layout(ncol = 4)+
  plot_annotation(title = 'A nice plot')&theme(plot.title = element_text(hjust=0.5))
#Display
Plot

库（tidyverse）
图书馆（gtable）
图书馆（网格）
图书馆（拼凑）
idx=1:16
#资料
p1=展开网格（id=idx，id2=c（“A”，“B”），x=1:10）%>%
突变（y=rnorm（n=n（））
#分割数据
列表这里有一个在网格中执行此操作的简单方法。我将“父”面稍微暗一些以强调嵌套，但是如果您喜欢匹配颜色，只需将
rectGrob
填充颜色更改为“gray85”


#根据示例设置绘图
库（tidyverse）
图书馆（gtable）
图书馆（网格）
idx=1:16
p1=展开网格（id=idx，id2=c（“A”，“B”），x=1:10）%>%
突变（y=rnorm（n=n（））%>%
ggplot（aes（x=x，y=y））+
几何抖动（）+
面包（~id+id2，nrow=4，ncol=8）
g我玩这个游戏有点晚了，但是ggh4x现在有一个
facet\u-nested\u-wrap（）
实现，可以大大简化这个问题（免责声明：我编写了ggh4x）

库（tidyverse）
图书馆（ggh4x）
idx=1:16
p1=展开网格（id=idx，id2=c（“A”，“B”），x=1:10）%>%
突变（y=rnorm（n=n（））%>%
ggplot（aes（x=x，y=y））+
几何抖动（）+
刻面嵌套换行（~id+id2，nrow=4，ncol=8）
p1


由（v0.3.0）于2020年8月12日创建

请记住，这里面可能还有一些错误。此外，我知道这对OP没有帮助，因为他的软件包版本受到限制，但我想我还是在这里提到了这一点。
这有帮助吗：@markus谢谢！ZNK对这个问题的回答正是我试图（但失败）在这里适应的答案（虽然teunbrand嵌套的facet_的第一个答案可以解决我的问题，但需要安装ggh4x包）@Björn抱歉，这与你的问题无关，但你能告诉我这些依赖限制吗？我试图将ggh4x的导入限制为只导入基本内容，但ggh4x建议的软件包应该只在使用它们的函数处调用，因此不需要安装它们。回到你的问题，
facet_nested（）
的工作原理类似于
facet\u grid（）
，而不像
facet\u wrap（）
，因此我认为这不会解决您的问题。@teunbrand这很尴尬。上次的安装似乎出了问题，但我使用
devtools:：install\u github（“teunbrand”）重复了它/ggh4x@v0.1“，力=T）
（我使用版本v0.1，因为我们的服务器上只有ggplot2 v3.2.1&关于用户可以安装什么有很多限制，要求用户检查他们安装什么，所以我不涉及tidyverse升级）它工作得很好。但是，正如你所说，我不能得到多行的镶嵌条。我想我可以为每行做一个单独的绘图，并将它们放在彼此下面（例如，使用拼图）@Björn是的，这似乎是一个合理的解决方案。感谢您对限制的解释，这对我很有帮助。我考虑过制作一个
facet_wrap（）
版本也是如此，但facetting code对程序来说太可怕了，所以我决定推迟它，直到有人开始要求它。无论如何，如果你不能安装新的添加项，这也不能解决你的问题。这太好了，谢谢分享！有没有关于扩展
strip.position=
以允许在顶部和顶部添加一些条带的想法旁白，你可能知道，当你发布与你有关联的资源的链接时，你应该在帖子中披露你的关联。可能值得在你的帖子中包含你的关联。是的，我想到了这个想法，但我还没有时间考虑好的解决方案来指定和实施它它。我对你评论的第二部分有点困惑。我的意思是，是的，我写了这个软件包，但我在业余时间做它。我不是为一家企业或公司写的。你认为我编辑的免责声明足够吗？是的，该免责声明是完美的（每个附属关系都需要披露的论点在中探讨）.再次感谢！
library(tidyverse)
library(gtable)
library(grid)
library(patchwork)

idx = 1:16

#Data

p1 = expand_grid(id=idx, id2=c("A", "B"), x=1:10) %>%
  mutate(y=rnorm(n=n()))

#Split data
List <- split(p1,p1$id)
#Sketch function
myplot <- function(x)
{
  d <- ggplot(x,aes(x=x,y=y)) +
    geom_jitter() +
    facet_wrap(~id2, nrow = 1, ncol=2)+
    ggtitle(unique(x$id))+
    theme(plot.title = element_text(hjust = 0.5))
  return(d)
}

#List of plots
Lplots <- lapply(List,myplot)
#Concatenate plots
#Create chain for plots
chain <- paste0('Lplots[[',1:length(Lplots),']]',collapse = '+')
#Evaluate the object and create the plot
Plot <- eval(parse(text = chain))+plot_layout(ncol = 4)+
  plot_annotation(title = 'A nice plot')&theme(plot.title = element_text(hjust=0.5))
#Display
Plot

stript <- grep("strip", g$layout$name)

grid_cols <- sort(unique(g$layout[stript,]$l))
t_vals <- rep(sort(unique(g$layout[stript,]$t)), each = length(grid_cols)/2)
l_vals <- rep(grid_cols[seq_along(grid_cols) %% 2 == 1], length = length(t_vals))
r_vals <- rep(grid_cols[seq_along(grid_cols) %% 2 == 0], length = length(t_vals))
labs   <- levels(as.factor(p1$data$id))

for(i in seq_along(labs))
{
  filler <- rectGrob(y = 0.7, height = 0.6, gp = gpar(fill = "gray80", col = NA))
  tg    <- textGrob(label = labs[i], y = 0.75, gp = gpar(cex = 0.8))
  g     <- gtable_add_grob(g, filler, t = t_vals[i], l = l_vals[i], r = r_vals[i], 
                           name = paste0("filler", i))
  g     <- gtable_add_grob(g, tg, t = t_vals[i], l = l_vals[i], r = r_vals[i], 
                           name = paste0("textlab", i))
}

grid.newpage()
grid.draw(g)