Plot a single y-axis legend using grid.arrange

Question

I would like to have grid.arrange behave similarly to ggplot2's facet_grid: I want my y-axis only on the leftmost plots, and still have all plots in the grid have the same size and aspect ratio. I know how to hide the y-axis on all plots that are not in the leftmost column, but this results in the plots being stretched to fill the same amount of y-space as the one with labels. Below is a reproducible example of my code:

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)))

This results in the folowing figure:

Separate y-axis for each grob

However, I would like to obtain something more akin to:

y-axis only for leftmost grobs

EDIT: Preferably using packages already imported by ggplot2, such as grid and gtable, so that my package does not require users to install an additional package.

Thank you sincerely for your advice on this matter!

Answer 1

try this,

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

I think I have found a solution: Instead of returning a list of ggplot objects, I return the ggplotGrob() of each plot. Then, I apply the $widths element of the first plot in the list to all other plots in the list:

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)))