使用grid.arrange繪制單個y軸圖例

Question

我希望grid.arrange的行為類似於ggplot2的facet_grid：我希望我的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)))

結果如下圖所示：

每個grob的y軸分別

但是，我想獲得更多類似於：

y軸僅適用於最左側的齒輪

編輯：最好使用已經由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)))