Question

我想让grid.arrange的行为类似于ggplot2的facet_grid：我希望我的y轴只在最左边的图上，并且网格中的所有图都具有相同的大小和宽高比。我知道如何在不在最左边的列中的所有绘图上隐藏y轴，但是这会导致绘图被拉伸以填充与带有标签的y空间相同的y空间。以下是我的代码的可重现示例：

library(gridExtra)

data <- data.frame(yi = rnorm(100), 
                   x1 = rnorm(100),
                   x2 = rnorm(100),
                   x3 = rnorm(100),
                   x4 = rnorm(100),
                   x5 = rnorm(100),
                   vi = rnorm(100, sd = .2))


data$x2 <- cut(data$x2, breaks = 2, labels = c("Low", "High"))
data$x3 <- cut(data$x3, breaks = 2, labels = c("Small", "Big"))

# Plot
select_vars <- names(data)[-which(names(data) %in% c("yi", "vi"))]
numeric_vars <-
  which(sapply(data[select_vars], class) %in% c("numeric", "integer"))

data$vi <- data$vi - min(data$vi) / (max(data$vi)-min(data$vi))

weights <- 1 / data$vi

n_grobs <- length(select_vars)
flr_n <- floor(sqrt(n_grobs))
cei_n <- ceiling(sqrt(n_grobs))
if((flr_n*cei_n) < n_grobs){
  flr_n <- flr_n + 1
}

plotdat <-
  data.frame(weights = weights / sum(weights), data[c(names(data)[which(names(data) %in% c("yi"))], select_vars)])

plots <- lapply(1:length(select_vars), function(x){
  current_variable <- select_vars[x]
  p <-
    ggplot(data.frame(plotdat[, c("yi", "weights", current_variable)], Variable = current_variable),
           aes_string(
             x = current_variable,
             y = "yi",
             size = "weights",
             weight = "weights"
           )) +
    facet_wrap("Variable") +
    theme_bw() +
    theme(legend.position = "none") +
    theme(axis.title.x = element_blank(),
          axis.title.y = element_blank())

  if(current_variable %in% select_vars[numeric_vars]){
    p <- p + geom_smooth(color = "darkblue", linetype = 2, method = "lm")
  } else {
    p <- p + geom_boxplot(outlier.shape = NA)
  }

  if(current_variable %in% select_vars[numeric_vars]){
    p <- p + geom_point(alpha = .2)
  } else {
    p <- p + geom_jitter(width = .2, alpha = .2)
  }
  p
})

grid.arrange(arrangeGrob(grobs = plots, ncol = cei_n, nrow = flr_n, as.table = TRUE, left = textGrob("yi", rot = 90, vjust = 1)))

这导致了下面的数字：

Separate y-axis for each grob

但是，我想获得更类似于：

的东西

y-axis only for leftmost grobs

编辑：最好使用已经由ggplot2导入的软件包，例如grid和gtable，这样我的软件包就不需要用户安装额外的软件包了。

真诚地感谢您对此事的建议！

Answer 1

试试这个，

remove_axis <- theme(axis.title.y = element_blank(), axis.text.y = element_blank(), axis.ticks.y = element_blank())
plots[-c(1,4)] <- lapply(plots[-c(1,4)] , function(.p) .p + remove_axis)

egg::ggarrange(plots=plots,ncol=3)

Answer 2

我想我找到了一个解决方案：我不返回ggplot对象列表，而是返回每个绘图的ggplotGrob（）。然后，我将列表中第一个绘图的$ widths元素应用于列表中的所有其他绘图：

library(gridExtra)
set.seed(33)
data <- data.frame(yi = rnorm(100), 
                   x1 = rnorm(100),
                   x2 = rnorm(100),
                   x3 = rnorm(100),
                   x4 = rnorm(100),
                   x5 = rnorm(100),
                   vi = rnorm(100, sd = .2))


data$x2 <- cut(data$x2, breaks = 2, labels = c("Low", "High"))
data$x3 <- cut(data$x3, breaks = 2, labels = c("Small", "Big"))

# Plot
select_vars <- names(data)[-which(names(data) %in% c("yi", "vi"))]
numeric_vars <-
  which(sapply(data[select_vars], class) %in% c("numeric", "integer"))

data$vi <- data$vi - min(data$vi) / (max(data$vi)-min(data$vi))

weights <- 1 / data$vi

n_grobs <- length(select_vars)
flr_n <- floor(sqrt(n_grobs))
cei_n <- ceiling(sqrt(n_grobs))
if((flr_n*cei_n) < n_grobs){
  flr_n <- flr_n + 1
}

plotdat <-
  data.frame(weights = weights / sum(weights), data[c(names(data)[which(names(data) %in% c("yi"))], select_vars)])

plots <- lapply(1:length(select_vars), function(x){
  current_variable <- select_vars[x]
  p <-
    ggplot(data.frame(plotdat[, c("yi", "weights", current_variable)], Variable = current_variable),
           aes_string(
             x = current_variable,
             y = "yi",
             size = "weights",
             weight = "weights"
           )) +
    facet_wrap("Variable") +
    theme_bw() +
    theme(legend.position = "none") +
    theme(axis.title.x = element_blank(),
          axis.title.y = element_blank())

  if(current_variable %in% select_vars[numeric_vars]){
    p <- p + geom_smooth(color = "darkblue", linetype = 2, method = "lm")
  } else {
    p <- p + geom_boxplot(outlier.shape = NA)
  }

  if(current_variable %in% select_vars[numeric_vars]){
    p <- p + geom_point(alpha = .2)
  } else {
    p <- p + geom_jitter(width = .2, alpha = .2)
  }
  if(!(x %in% seq.int(1, length(select_vars), by = cei_n))){
    p <- p + theme(axis.title.y = element_blank(),
                   axis.text.y = element_blank(),
                   axis.ticks.y = element_blank())
  }
  ggplotGrob(p)
})

plots[2:length(plots)] <- lapply(plots[2:length(plots)], function(x){
  x$widths <- plots[[1]]$widths
  x
})

grid.arrange(arrangeGrob(grobs = plots, ncol = cei_n, nrow = flr_n, as.table = TRUE, left = textGrob("yi", rot = 90, vjust = 1)))

使用grid.arrange绘制单个y轴图例

2 个答案: