Построить одну легенду по оси Y, используя grid.arrange

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

Это приводит к следующему рисунку:

Отдельная ось Y для каждого гроба

Однако я хотел бы получить что-то более похожее на:

Ось Y только для крайних левых гробов

РЕДАКТИРОВАТЬ: предпочтительно использовать пакеты, уже импортированные ggplot2, такие как grid и gtable, чтобы мой пакет не требовал от пользователей установки дополнительного пакета.

Искренне благодарю за совет по этому вопросу!

Answer 1

Я думаю, что нашел решение: вместо того, чтобы возвращать список объектов 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)))

Answer 2

попробуйте,

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)