如何在ggplot隐藏分面条带文本的同时减小条带高度

冲突原因很简单：theme(strip.text = element_blank())会直接移除整个条带文本元素，你针对strip.text设置的边距参数自然会失效，也就没法控制条带高度了。可以用下面两种任选的方法实现需求：

方法1：兼容旧版ggplot2 #

不要直接移除文本元素，把文本设为不可见，再通过边距调整高度，替换你原有的theme(strip.text = element_blank())即可：

theme(
  # 文字设为全透明+字号为0，实现隐藏效果
  strip.text = element_text(color = "transparent", size = 0, 
                            # 四个参数对应上/右/下/左的边距，调小上下边距即可缩小条带高度
                            margin = margin(1, 0, 1, 0, "mm")),
  # 如果不需要条带背景可以加这行，不需要就删掉
  strip.background = element_blank()
)

方法2：ggplot2 >=3.3.0版本可用，更直观 #

直接用官方新增的strip.height参数指定条带高度，哪怕保留element_blank()也能生效：

theme(
  strip.text = element_blank(),
  # 直接指定条带高度，数值调越小条带越窄
  strip.height = unit(2, "mm")
)

修改后的核心代码参考 #

你只需要调整dummy和p1的theme部分即可，完整修改后的代码如下：

library(gtable)
library(gridExtra)
library(ggplot2)
library(dplyr)

p1= df %>%
  ggplot(aes(x= estimate, y=term)) +
  geom_text(aes(label = cntry, x =  Inf, y = Inf), vjust = 1.75, hjust =1)+
  geom_point(mapping=aes(x=estimate, y=term)) +
  facet_wrap(vars(cntry,continent)) +
  # 同步设置条带高度，保持和dummy一致
  theme(strip.text = element_blank(), strip.height = unit(2, "mm"))


dummy= df %>%
  ggplot(aes(x = estimate, y = term))+ 
  facet_wrap(vars(cntry,continent)) +
  geom_rect(aes(fill=continent), xmin=-Inf, xmax=Inf, ymin=-Inf, ymax=Inf) +
  theme_minimal() +
  # 替换原来的strip.text=element_blank()即可，这里用方法2示例
  theme(strip.text = element_blank(), strip.height = unit(2, "mm"))

# 后面的gtable操作、图例提取、导出代码都不用改，直接跑即可
g1 <- ggplotGrob(p1)
g2 <- ggplotGrob(dummy)

gtable_select <- function (x, ...) 
{
  matches <- c(...)
  x$layout <- x$layout[matches, , drop = FALSE]
  x$grobs <- x$grobs[matches]
  x
}

panels <- grepl(pattern="panel", g2$layout$name)
strips <- grepl(pattern="strip-t", g2$layout$name)
g2$layout$t[panels] <- g2$layout$t[panels] - 1
g2$layout$b[panels] <- g2$layout$b[panels] - 1

new_strips <- gtable_select(g2, panels | strips)

gtable_stack <- function(g1, g2){
  g1$grobs <- c(g1$grobs, g2$grobs)
  g1$layout <- transform(g1$layout, z= z-max(z), name="g2")
  g1$layout <- rbind(g1$layout, g2$layout)
  g1
}

new_plot <- gtable_stack(g1, new_strips)

# Extract only the legend from "dummy" plot
g_legend <- function(dummy){ 
  tmp <- ggplot_gtable(ggplot_build(dummy)) 
  leg <- which(sapply(tmp$grobs, function(x) x$name) == "guide-box") 
  legend <- tmp$grobs[[leg]] 
  return(legend)} 
# Assign the legend to a separate object
facet.legend <- g_legend(dummy)


jpeg("legend_graph.jpg", width = 8, height = 6, units = "in", res = 300)
print(grid.arrange(new_plot, facet.legend, nrow = 2, widths = c(7, 1), heights = c(6, 0.01)))
dev.off()

你提供的效果示意图如下：

内容的提问来源于stack exchange，提问作者Jack