ggplot2：使用gtable将strip标签移动到facet_grid的面板顶部 [英] ggplot2: Using gtable to move strip labels to top of panel for facet_grid

问题描述

我使用 facet_grid 创建一个图形以在y轴上构造一个分类变量。我决定不使用 facet_wrap ，因为我需要 space ='free'和 labeller = label_parsed 。我的标签很长，我在右侧有一个图例，所以我想将标签从面板的右侧移动到面板的顶部。

这里是

  library（ggplot2）
 library（gtable）
 
 mt < -  ggplot（mpg，aes（x = cty，y = model））+ geom_point（）+ 
 facet_grid（manufacturer〜。，scales ='free'，space ='free' ）+ 
 theme_minimal（）+ 
 theme（panel.margin = unit（0.5，'lines'），strip.text.y = element_text（angle = 0））
  

p>

现在我想将每个面板右侧的条形文本移动到每个面板的顶部。我可以存储条形标签的grobs，并将其从条形图中删除：

  grob < -  ggplotGrob（mt）
 strips.y<  -  gtable_filter（grob，'strip-right'）
 grob2<  -  grob [， -  5] 
  

但是现在我遇到 rbind - 卡住了grobs，所以标签会进入面板的顶部。

另一种可能的解决方案是使用 facet_wrap ，然后重新设置面板的大小。

  library（ggplot2）
 library（gtable）
 
 mt < -  ggplot（mpg，aes（x = cty，y = model））+ geom_point（）+ 
 facet_wrap（〜manufacturer，scales =free_y，ncol = 1） + 
 theme（panel.margin = unit（0.2，'lines'））
 
 
 facet_wrap_labeller<  -  function（gg.plot，labels = NULL）{
要求（gridExtra）
 
g < -  ggplotGrob（gg.plot）
 gg < -  g $ grobs 
条带< -  grep（strip_t，names（gg ））
 
 for（ii in seq_along（labels））{
 modgrob<  -  getGrob（gg [[strips [ii]]]，strip.text，
 grep = TRUE，global = TRUE）
 gg [[strip [ii]]] $ children [[modgrob $ name]]<  -  editGrob（modgrob，label = labels [ii]）
} 
 
g $ grobs<  -  gg 
 class（g）= c（arrange，ggplot，class（g））
 return（g）
} 
 
 ##每个面板中的y中断的数量
g < -  ggplot_build（mt）
 N < -  sapply（lapply（g $ panel $ ranges，[[ ，y.major），长度）
 
＃一些任意的条形文本
 StripTexts =表达式（gamma [1]，sqrt（gamma [2]），C，`真的令人难以置信gamma [5]，alpha [1]，alpha [2]，Land Rover，alpha [1]，beta [2]，g amt ^ 2，delta ^ 2，epsilon [2]，zeta [3]，eta [4]）
 
＃应用facet_wrap_labeller函数
 gt = facet_wrap_labeller（mt，StripTexts）
 
＃获取布局中的面板位置
面板<  -  gt $ layout $ t [grepl（panel，gt $ layout $ name）] 
 
＃用相对高度替换默认面板高度
 gt $ heights [panels]<  -  lapply（N，unit，null）
 
＃绘制
 gt 
  

I am creating a graphic using facet_grid to facet a categorical variable on the y-axis. I decided not to use facet_wrap because I need space = 'free' and labeller = label_parsed. My labels are long and I have a legend on the right so I would like to move the labels from the right of the panel to the top of the panel.

Here is an example to show where I'm getting stuck.

library(ggplot2)
library(gtable)

mt <- ggplot(mpg, aes(x = cty, y = model)) + geom_point() +
  facet_grid(manufacturer ~ ., scales = 'free', space = 'free') +
  theme_minimal() +
  theme(panel.margin = unit(0.5, 'lines'), strip.text.y = element_text(angle = 0))

Now I would like to move the strip text from the right of each panel to the top of each panel. I can store the grobs for the strip labels and remove them from the plot:

grob <- ggplotGrob(mt)
strips.y <- gtable_filter(grob, 'strip-right')
grob2 <- grob[,-5]

But now I'm stuck when it comes to rbind-ing the grobs back so the labels go to the top of the panels.

Another possible solution would be to use facet_wrap and then re-size the panels as discussed in another question, but in that case I would have to manually change the labels on the facets because there is no labeller = label_parsed for facet_wrap.

I'd appreciate suggestions on either approach!

Thanks for reading,

Tom

解决方案

This takes your first approach. It inserts a row above each of the panels, grabs the strip grobs (on the right), and inserts them into the new rows.

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

mt <- ggplot(mpg, aes(x = cty, y = model)) + geom_point() +
  facet_grid(manufacturer ~ ., scales = 'free', space = 'free') +
  theme(panel.margin = unit(0.5, 'lines'), 
         strip.text.y = element_text(angle = 0))

# Get the gtable
gt <- ggplotGrob(mt)

# Get the position of the panels in the layout
panels <-c(subset(gt$layout, name=="panel", se=t:r))

# Add a row above each panel
for(i in rev(panels$t-1)) gt = gtable_add_rows(gt, unit(.5, "lines"), i)

# Get the positions of the panels and the strips in the revised layout
panels <-c(subset(gt$layout, name=="panel", se=t:r))
strips <- c(subset(gt$layout, name=="strip-right", se=t:r))

# Get the strip grobs
stripText = gtable_filter(gt, "strip-right")

# Insert the strip grobs into the new rows
for(i in 1:length(strips$t)) gt = gtable_add_grob(gt, stripText$grobs[[i]],  t=panels$t[i]-1, l=4, r=4)

# Remove the old strips
gt = gt[,-5]

# For this plot - adjust the heights of the strips and the empty row above the strips
for(i in panels$t) {
   gt$heights[i-1] = list(unit(0.8, "lines"))
   gt$heights[i-2] = list(unit(0.2, "lines"))
   }

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

OR, you can achieve the second approach using a facet_wrap_labeller function available from here.

library(ggplot2)
library(gtable)

mt <- ggplot(mpg, aes(x = cty, y = model)) + geom_point() +
   facet_wrap(~ manufacturer, scales = "free_y", ncol = 1) +
   theme(panel.margin = unit(0.2, 'lines'))


facet_wrap_labeller <- function(gg.plot, labels=NULL) {
  require(gridExtra)

  g <- ggplotGrob(gg.plot)
  gg <- g$grobs      
  strips <- grep("strip_t", names(gg))

  for(ii in seq_along(labels))  {
    modgrob <- getGrob(gg[[strips[ii]]], "strip.text", 
                       grep=TRUE, global=TRUE)
    gg[[strips[ii]]]$children[[modgrob$name]] <- editGrob(modgrob,label=labels[ii])
  }

  g$grobs <- gg
  class(g) = c("arrange", "ggplot",class(g)) 
  return(g)
}

## Number of y breaks in each panel
g <- ggplot_build(mt) 
N <- sapply(lapply(g$panel$ranges, "[[", "y.major"), length)

# Some arbitrary strip texts
StripTexts = expression(gamma[1], sqrt(gamma[2]), C, `A really incredibly very very very long label`, gamma[5], alpha[1], alpha[2], `Land Rover`, alpha[1], beta[2], gamma^2, delta^2, epsilon[2], zeta[3], eta[4] )

 # Apply the facet_wrap_labeller function
gt = facet_wrap_labeller(mt, StripTexts)

# Get the position of the panels in the layout
panels <- gt$layout$t[grepl("panel", gt$layout$name)]

# Replace the default panel heights with relative heights
gt$heights[panels] <- lapply(N, unit, "null")

# Draw it
gt

这篇关于ggplot2：使用gtable将strip标签移动到facet_grid的面板顶部的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！