打印存储在列表中的 ggplot 对象时不会保留方面标签

Question

Here is the data that I will be using to give context to my question:

library(dplyr)
library(tidyr)
library(ggplot2)

set.seed(1)
f1 <- sample(c(letters[1:3],NA),100, prob = c(rep((0.9/3),times = 3),0.1),replace = T)
f2 <- sample(c(letters[1:3],NA),100, prob = c(rep((0.8/3),times = 3),0.2),replace = T)
f3 <- sample(c(letters[1:3],NA),100, prob = c(rep((0.95/3),times = 3),0.01),replace = T)

sample_dat <- tibble(
  x1 = factor(f1, level=letters[1:3]),
  x2 = factor(f2, level=letters[1:3]),
  x3 = factor(f3, level=letters[1:3]),
  grpA = factor(sample(c("grp1","grp2"),100, prob=c(0.3, 0.7) ,replace=T), 
    levels = c("grp1", "grp2"))
  
)

sample_dat

here is a function that I created to prepare the data for plotting:

plot_data_prepr <- function(dat, groupvar, mainvar){
  
  groupvar <- sym(groupvar)
  mainvar <- sym(mainvar)
  
  plot_data <- dat %>% 
    group_by(!!groupvar) %>% 
    count(!!mainvar, .drop = F) %>% drop_na() %>% 
    mutate(pct = n/sum(n),
         pct2 = ifelse(n == 0, 0.005, n/sum(n)),
         grp_tot = sum(n),
         pct_lab = paste0(format(pct*100, digits = 1),'%'),
         pct_pos = pct2 + .02)
  
  return(plot_data)
}

here is the application of the function to produce the data sets I will use for plotting

plot_data_prepr(dat = sample_dat, groupvar = "grpA", mainvar = "x1")
plot_data_prepr(dat = sample_dat, groupvar = "grpA", mainvar = "x2")
plot_data_prepr(dat = sample_dat, groupvar = "grpA", mainvar = "x3")

here I use a for loop to plot the data and dynamically change the labels of the facets -- if one runs this in rstudio as an RMarkdown file, one can see that the plots are produced and the labels for the facets are each distinct as they should be given the different degrees of missingness and sampling densities for the 'grpA' variable.

plot_list <- vector('list', length = 0)

for (fct in names(sample_dat)[1:3]){
  
  mvar <- fct
  smvar <- sym(mvar)
  
  gvar <- "grpA"
  sgvar <- sym(gvar)
  
  
dd <- plot_data_prepr(dat = sample_dat, groupvar = gvar, mainvar = mvar)

pre_lookup <- dd %>% 
  select(!!sgvar, grp_tot) %>% 
  group_by(!!sgvar) %>% 
  summarise(lookup = mean(grp_tot))


lookup <- pre_lookup$lookup

  my_label <- function(x) {
    var <- names(x)[1]
    list(paste0(x[[var]], " (N = ", lookup, ")"))
  }
  
  
  plot <- ggplot(dd,
         mapping = aes(x=!!smvar, y = pct2, fill = !!smvar)) +
    geom_bar(stat = 'identity') +
    ylim(0,1.3) +
    geom_text(aes(x=!!smvar, label=pct_lab, y = pct_pos + .02)) +
    facet_grid(as.formula(paste0(".~", gvar)), labeller = my_label) +
    ggtitle(paste(gvar,"by",mvar))
  
  plot_list[[fct]] <- plot
  
  print(plot)

}

Here's my problem -- when I print the plots which are stored in the list, they all seem to retain the facet label from the last plot, instead of retaining the distinct facet-labels they displayed when they were originally generated.

for (name in names(sample_dat)[1:3]){
  print(plot_list[[name]])
}

Basically, I would like to be able to print the plots from the list when I need them and have them display their distinct facet labels as they had been displayed when the plots were originally produced.

Perhaps someone in the community could help me?

Answer 1

I would suggest you try to avoid the loop for the plots building. It uses to create that kind of issues as you have with labels or sometimes with data. Here, I have packaged your loop in a function and stored the results in a list. Also, you can use lapply() with the names of your data in order to directly create the list with the plots. Here the code:

#Function for plot
myplotfun <- function(fct)
{
  mvar <- fct
  smvar <- sym(mvar)
  
  gvar <- "grpA"
  sgvar <- sym(gvar)
  
  
  dd <- plot_data_prepr(dat = sample_dat, groupvar = gvar, mainvar = mvar)
  
  pre_lookup <- dd %>% 
    select(!!sgvar, grp_tot) %>% 
    group_by(!!sgvar) %>% 
    summarise(lookup = mean(grp_tot))
  
  
  lookup <- pre_lookup$lookup
  
  
  my_label <- function(x) {
    var <- names(x)[1]
    list(paste0(x[[var]], " (N = ", lookup, ")"))
  }
  
  
  plot <- ggplot(dd,
                 mapping = aes(x=!!smvar, y = pct2, fill = !!smvar)) +
    geom_bar(stat = 'identity') +
    ylim(0,1.3) +
    geom_text(aes(x=!!smvar, label=pct_lab, y = pct_pos + .02)) +
    facet_grid(as.formula(paste0(".~", gvar)), labeller = my_label) +
    ggtitle(paste(gvar,"by",mvar))
  
  return(plot)
}

Now, we create a list:

#Create a list
plot_list <- lapply(names(sample_dat)[1:3],myplotfun)

Finally, the plots as you used in the last loop:

#Loop
for (i in 1:length(plot_list)){
  plot(plot_list[[i]])
}

Outputs:

Answer 2

The problem is your my_label function has a free variable lookup that's only resolved when you actually plot the function. After your for-loop runs, then you it only contains the last value in the loop. To capture the current loop value, you can place it inside an enclosure. So you could change the my_label function to

  my_labeler <- function(lookup) {
    function(x) {
      var <- names(x)[1]
      list(paste0(x[[var]], " (N = ", lookup, ")"))
    }
  }

and then call facet_grid with

  facet_grid(as.formula(paste0(".~", gvar)), labeller = my_labeler(lookup))

But I agree with @Duck that avoiding the for-loop in this case would be easier.