如何为 ggplot 中的每个构面行添加 y 轴标题?

How to add y axis title for each facet row in ggplot?

我正在用这样的 facet_grid() 绘制散点图:

library(ggplot2)
ggplot(df, aes(x, y)) +
  geom_point() +
  facet_grid(group1 ~ group2)

我希望 y 轴标题 y 像这样位于每一行的中间(油漆解决方案):

此示例中的构面行数是两个,因为 df$group2 有两个不同的值。对于我的实际用例,可能有两行以上,具体取决于使用的 facet 变量; y 轴标题应该位于 each facet 行的中间。

目前最好的解决方案是 ,这是一团糟,因为使用不同长度的 y 轴标题会将文本从行的中间移开。 必须与ggplot2一起使用,即不使用额外的包。我做了一个包,不想依赖/包含太多包。

此处使用的数据:

df <- data.frame(x= rnorm(100), y= rnorm(100),
                 group1= rep(0:1, 50), group2= rep(2:3, each= 50))

您可以考虑切换到库 (cowplot) 以获得更多控制

可以将以下代码添加到函数中,但为了清楚起见,我将其保留了很长时间。创建 4 个数据框并将它们提供给四个绘图。然后排列地块

library(tidyverse)
df <- data.frame(x= rnorm(100), y= rnorm(100),
                 group1= rep(0:1, 50), group2= rep(2:3, each= 50))


library(cowplot)
df1 <- df %>% 
  filter(group2 == 2) %>% 
         filter(group1 == 0)

df2 <- df %>% 
  filter(group2 == 3) %>% 
  filter(group1 == 0)

df3 <- df %>% 
  filter(group2 == 2) %>% 
  filter(group1 == 1)

df4 <- df %>% 
  filter(group2 == 3) %>% 
  filter(group1 == 1)

plot1 <- ggplot(df1, aes(x, y)) +
  geom_point() +
  facet_grid(group1 ~ group2)+
  xlim(c(-3, 3))+
  ylim(c(-3, 2))+
  theme(strip.text.y = element_blank(), 
        axis.title.x = element_blank(), 
        axis.text.x = element_blank(), 
        axis.ticks.x = element_blank()
        )
plot1


plot2 <- ggplot(df2, aes(x, y)) +
  geom_point() +
  facet_grid(group1 ~ group2)+
  xlim(c(-3, 3))+
  ylim(c(-3, 2))+
  theme(axis.title.y = element_blank(), 
        axis.text.y = element_blank(), 
        axis.ticks.y = element_blank(), 
        axis.title.x = element_blank(), 
        axis.text.x = element_blank(), 
        axis.ticks.x = element_blank()
        )
plot2


plot3 <- ggplot(df3, aes(x, y)) +
  geom_point() +
  facet_grid(group1 ~ group2)+
  xlim(c(-3, 3))+
  ylim(c(-3, 2))+
  theme(strip.text.x = element_blank(),
        strip.text.y = element_blank())
plot3


plot4 <- ggplot(df4, aes(x, y)) +
  geom_point() +
  facet_grid(group1 ~ group2)+
  xlim(c(-3, 3))+
  ylim(c(-3, 2))+
  theme(axis.title.y = element_blank(), 
        strip.text.x = element_blank(),
        axis.text.y = element_blank(), 
        axis.ticks.y = element_blank())
plot4

plot_grid(plot1, plot2, plot3, plot4)

在不使用其他包的情况下,我认为最好的方法是建立在您在原始问题中链接的空间解决方案的基础上。所以我写了一个函数让标签间距更稳健一点。

ylabel <- function(label1,label2){
  L1 <- nchar(label1)
  L2 <- nchar(label2)
  scaler <- ifelse(L1 + L2 > 8, 4, 0)
  space1 = paste0(rep("",27 - (L1/2)),collapse = " ")
  space2 = paste0(rep("",44 - (L1/2 + L2/2) - scaler), collapse = " ")
  space3 = paste0(rep("",22 - (L2/2)), collapse = " ")
  paste0(space1,label1,space2,label2,space3)
}

申请:

test <- ylabel("automobiles", "trucks")
ggplot(df, aes(x, y)) +
  geom_point() +
  facet_grid(group1 ~ group2) +
  ylab(test)

仍在研究 scaler 参数,它并不完美:

test2 <- ylabel("super long label", "a")
ggplot(df, aes(x, y)) +
  geom_point() +
  facet_grid(group1 ~ group2) +
  ylab(test2)

将继续完善 function/parameters,但我认为这会让您更接近您正在寻找的内容。

您可以将轴标签复制到 gtable 中的新 grob 中。请注意,尽管这使用了 gridgtable 包,但这些包已由 ggplot2 导入,因此这不会添加任何新的依赖项,这些依赖项尚不可用且未被 ggplot 内部使用。

library(grid)
library(gtable)

g = ggplot(df, aes(x, y)) +
  geom_point() +
  facet_grid(group1 ~ group2)

gt = ggplot_gtable(ggplot_build(g))
which.ylab = grep('ylab-l', gt$layout$name)
gt = gtable_add_grob(gt, gt$grobs[which.ylab], 8, 3)
gt = gtable_add_grob(gt, gt$grobs[which.ylab], 10, 3)
gt = gtable_filter(gt, 'ylab-l', invert = TRUE) # remove the original axis title
grid.draw(gt)

以上适用于只有两个方面的 OP 示例。如果我们想对任意数量的方面进行概括,我们可以通过搜索 gtable 以查看哪些行包含 y 轴来简单地做到这一点。

gt = ggplot_gtable(ggplot_build(g))
which.ylab = grep('ylab-l', gt$layout$name)
which.axes = grep('axis-l', gt$layout$name)
axis.rows  = gt$layout$t[which.axes]
label.col  = gt$layout$l[which.ylab]
gt = gtable::gtable_add_grob(gt, rep(gt$grobs[which.ylab], length(axis.rows)), axis.rows, label.col)
gt = gtable::gtable_filter  (gt, 'ylab-l', invert = TRUE) 
grid::grid.draw(gt)

在上面的版本中,我还使用 :: 为 grid 和 gtable 包中的函数明确指定命名空间。这将允许代码工作,甚至无需将其他包加载到搜索路径中。

使用另一个包含四个分面行的示例演示此代码:

df <- data.frame(x= rnorm(100), y= rnorm(100),
                 group1= rep(1:4, 25), group2= rep(1:2, each= 50))

这是一个带注释的版本,仅使用 ggplot2。它应该是可扩展的。

不要乱来。缺点是 x 定位和绘图边距需要 semi-manually 定义,这可能不是很稳健。

library(ggplot2)

df <- data.frame(x= rnorm(100), y= rnorm(100),
                 group1= rep(0:1, 50), group2= rep(2:3, each= 50))

## define a new data frame based on your groups, so this is scalable
annotate_ylab <- function(df, x, y, group1, group2, label = "label") {
  ## make group2 a factor, so you know which column will be to the left
  df[[group2]] <- factor(df[[group2]])
  lab_df <- data.frame( 
    ## x positioning is a bit tricky,
    ## I think a moderately robust method is to
    ## set it relativ to the range of your values
    x = min(df[[x]]) - 0.2 * diff(range(df[[x]])),
    y = mean(df[[y]]),
    g1 = unique(df[[group1]]),
    ## draw only on the left column
    g2 = levels(df[[group2]])[1],
    label = label
  )
  names(lab_df) <- c(x, y, group1, group2, "label")
  lab_df
}

y_df <- annotate_ylab(df, "x", "y", "group1", "group2", "y")

ggplot(df, aes(x, y)) +
  geom_point() +
  geom_text(data = y_df, aes(x, y, label = label), angle = 90) +
  facet_grid(group1 ~ group2) +
  coord_cartesian(xlim = range(df$x), clip = "off") +
  theme(axis.title.y = element_blank(), 
        plot.margin = margin(5, 5, 5, 20))

y_df_mtcars <- annotate_ylab(mtcars, "mpg", "disp", "carb", "vs", "y")

ggplot(mtcars, aes(mpg, disp)) +
  geom_point() +
  geom_text(data = y_df_mtcars, aes(mpg, disp, label = label), angle = 90) +
  facet_grid(carb ~ vs) +
  coord_cartesian(xlim = range(mtcars$mpg), clip = "off") +
  theme(axis.title.y = element_blank(), 
        plot.margin = margin(5, 5, 5, 20))

reprex package (v2.0.1)

于 2021-11-24 创建