How to extract multiple ggplot from nested list and plot them like facet_grid?

Question

I have written a custom function which returns a list of ggplot with some data. Here is the function

custom_fun <- function(x = x){
  x = x
  # Calculate the length
  n <- length(x)
  
  # First half arranged in ascending order
  fh <- sort(x[1:(n/2)])
  
  # Second half arranged in ascending order
  sh <- sort(x[((n/2)+1):n])
  
  d <- cbind.data.frame(fh, sh)

  #Some calculations
  dis = sqrt(diff(d$fh)^2 + diff(d$sh)^2)
  sl = diff(d$sh) / diff(d$fh)
  
  #Plotting using ggplot2
    myplot <- function(mydf, xcol, ycol){
      ggplot2::ggplot(data = mydf, ggplot2::aes(x = {{xcol}}, y = {{ycol}})) +
        ggplot2::geom_point(color='red', alpha=0.3, size=2)+
        ggplot2::geom_segment(color="#69b3a2", 
                              ggplot2::aes(xend=c(tail({{xcol}}, n=-1), NA), 
                                  yend=c(tail({{ycol}}, n=-1), NA))
        ) +
        ggplot2::geom_abline (slope=1, linetype = "dashed", color="Red") +
        ggplot2::xlab(" ") +
        ggplot2::ylab(" ")
    }
  
  my_plot <- myplot(d, fh, sh)
  
  return(list(`Dis` = dis, `SL` = sl,
              `Plot` = my_plot))
}

I am using lapply to apply the function to multiple columns like

try <- lapply(iris[-5], custom_fun)

Now, how can I extract the ggplots and make multipanel plots like the following plot?

Answer 1

Here's a patchwork solution including modification of the position of the title, or any other theme element. (stealing the first part of @benson23 answer)

library(patchwork)
try_list <- lapply(iris[-5], custom_fun)

wrap_plots(lapply(names(try_list), \(x) try_list[[x]][["Plot"]]+ggtitle(x))) & 
  theme(plot.title = element_text(hjust=0.5) )

Answer 2

You can first extract all plots, then use the plotlist argument in ggarrange from the ggpubr package.

To include the labels on top of each plot, first expand the plot margins in your ggplot codes, then play around with the ggarrange(vjust) parameter to get the best outcome.

library(ggplot2)
library(ggpubr)


custom_fun <- function(x = x){
  x = x
  # Calculate the length
  n <- length(x)
  
  # First half arranged in ascending order
  fh <- sort(x[1:(n/2)])
  
  # Second half arranged in ascending order
  sh <- sort(x[((n/2)+1):n])
  
  d <- cbind.data.frame(fh, sh)
  
  #Some calculations calculation
  dis = sqrt(diff(d$fh)^2 + diff(d$sh)^2)
  sl = diff(d$sh) / diff(d$fh)
  
  #Plotting using ggplot2
  myplot <- function(mydf, xcol, ycol){
    ggplot2::ggplot(data = mydf, ggplot2::aes(x = {{xcol}}, y = {{ycol}})) +
      ggplot2::geom_point(color='red', alpha=0.3, size=2)+
      ggplot2::geom_segment(color="#69b3a2", 
                            aes(xend=c(tail({{xcol}}, n=-1), NA), 
                                yend=c(tail({{ycol}}, n=-1), NA))
      ) +
      ggplot2::geom_abline (slope=1, linetype = "dashed", color="Red") +
      ggplot2::xlab(" ") +
      ggplot2::ylab(" ") +
      theme(plot.margin = unit(c(1.5, 0, 0, 0), "lines")) # add this code
  }
  
  my_plot <- myplot(d, fh, sh)
  
  return(list(`Dis` = dis, `SL` = sl,
              `Plot` = my_plot))
}

try_list <- lapply(iris[-5], custom_fun)

ggarrange(plotlist = lapply(try_list, `[[`, "Plot"), labels = names(try_list), vjust = 1.5)

Or iterating the plots in plotlist to add ggtitle (idea is from @George Savva)

ggarrange(plotlist = lapply(names(try_list), \(x) try_list[[x]]$Plot + ggtitle(x)))