Looping over grouped data and saving plots with ggplot

I have a large dataset that looks like this:

df <- data.frame(Year=rep(c('2010','2020'),times=7),
                Site=c('1-A','1-A','1-B','1-B','2-A','2-A','2-B','2-B',
                       '3-A','3-A','3-B','3-B','3-C','3-C'),
                V1=rnorm(14,20,5),
                V2=rnorm(14,50,10),
                V3=rnorm(14,5,0.25))

I want to be able to loop over the dataset and create a plot for each 'V' column that is then grouped by year, then by site letter. Then I would like to combine all the plots from each site number-letter combo together.

This is the code I have to just plot one site.

    df1 <- subset(df, substring(df$Site,1,1)=='1')


p1 <- ggplot(df1, aes(fill=Year, y = V1,x=Site))  
  geom_bar(position = 'dodge',stat = 'identity',colour='black')  
  ylab('V1')  
  theme_classic()  
  theme(legend.position = "bottom",panel.border = element_rect(colour = "black", fill = NA, size = 1))  
  theme(plot.title = element_text(hjust = 0.5))  
  scale_y_continuous(expand = c(0, 0),
                     sec.axis = dup_axis(name = NULL)) 
        
p2 <- ggplot(df1, aes(fill=Year, y = V2,x=Site))  
  geom_bar(position = 'dodge',stat = 'identity',colour='black')  
  ylab('V2')  
  theme_classic()  
  theme(legend.position = "bottom",panel.border = element_rect(colour = "black", fill = NA, size = 1))  
  theme(plot.title = element_text(hjust = 0.5))  
  scale_y_continuous(expand = c(0, 0),
                     sec.axis = dup_axis(name = NULL)) 

p3 <- ggplot(df1, aes(fill=Year, y = V3,x=Site))  
  geom_bar(position = 'dodge',stat = 'identity',colour='black')  
  ylab('V3')  
  theme_classic()  
  theme(legend.position = "bottom",panel.border = element_rect(colour = "black", fill = NA, size = 1))  
  theme(plot.title = element_text(hjust = 0.5))  
  scale_y_continuous(expand = c(0, 0),
                     sec.axis = dup_axis(name = NULL)) 

get_legend            <-function(myggplot){
  tmp                 <- ggplot_gtable(ggplot_build(myggplot))
  leg                 <- which(sapply(tmp$grobs, function(x) x$name) == "guide-box")
  legend              <- tmp$grobs[[leg]]
  return(legend)
}

mylegend <- get_legend(p1   theme(legend.title = element_blank()))


grid.arrange(arrangeGrob(
  (p1   theme(legend.position="none")), 
  (p2   theme(legend.position="none")),
  (p3   theme(legend.position="none")),
  ncol=3),mylegend,heights=c(15,1),
  top=textGrob('Plots', 
               gp=gpar(fontsize=14)))

With the final plot looking like:

My full dataset is much larger so I would rather not have to type this out hundreds of times.

I tried to write a loop to do this using:

p <- list()

for (i in unique(substring(df$Site,1,1))){
  data <- subset(df, substring(df$Site,1,1)==i)
  for (j in 3:(ncol(data))){
    x <- data[j]
    colnames(x) <- 'tmp'
    p[[i]] <- ggplot(data, aes(fill=Year, y = x$tmp, x=Site))  
      geom_bar(position = 'dodge',stat = 'identity',colour='black')  
      ylab(names(data[j]))  
      theme_classic()  
      theme(legend.position = "bottom", panel.border = element_rect(colour = "black",
                                                            fill = NA,size = 1))  
      scale_y_continuous(expand = c(0, 0),
                         sec.axis = dup_axis(name = NULL)) 
    
  }
}

But I keep getting an error on all the plots in the list except for the last one: p[3]

Error in `check_aesthetics()`:
! Aesthetics must be either length 1 or the same as the data (4): y

Any help on this would be appreciated.

CodePudding user response：

An alternative approach using patchwork, purrr::pmap for the looping and a plotting function my look like so:

library(ggplot2)
library(patchwork)
library(purrr)

set.seed(123)

plot_fun <- function(x, y) {
  df1 <- subset(df, substring(Site, 1, 1) == y)
  ggplot(df1, aes(fill = Year, y = .data[[x]], x = Site))  
    geom_bar(position = "dodge", stat = "identity", colour = "black")  
    ylab(x)  
    theme_classic()  
    theme(legend.position = "bottom", panel.border = element_rect(colour = "black", fill = NA, size = 1))  
    theme(plot.title = element_text(hjust = 0.5))  
    scale_y_continuous(
      expand = c(0, 0),
      sec.axis = dup_axis(name = NULL)
    )
}

p_grid <- expand.grid(
  x = paste0("V", 1:3), y = 1:3,
  stringsAsFactors = FALSE
)

purrr::pmap(p_grid, plot_fun) |>
  wrap_plots()  
  plot_layout(ncol = 3, guides = "collect") &
  theme(legend.position = "bottom")

UPDATE Getting separate plots for each Site number isn't a big deal. Here we could first split the p_grid then wrap inside another purrr::map or lapply:

p_grid_split <- split(p_grid, p_grid$y)

purrr::map(p_grid_split, function(p_grid) {
  purrr::pmap(p_grid, plot_fun) |>
    wrap_plots()  
    plot_layout(ncol = 3, guides = "collect") &
    theme(legend.position = "bottom")  
})
#> Warning: The `size` argument of `element_rect()` is deprecated as of ggplot2 3.4.0.
#> ℹ Please use the `linewidth` argument instead.
#> $`1`

#> 
#> $`2`

#> 
#> $`3`