Блог

Вот данные, которые я буду использовать, чтобы дать контекст моему вопросу:

 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
  

вот функция, которую я создал для подготовки данных к построению графика:

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

вот применение функции для создания наборов данных, которые я буду использовать для построения графика

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

  

здесь я использую цикл for для построения данных и динамического изменения меток фасетов — если запустить это в
rstudio как файл RMarkdown, можно увидеть, что графики создаются, а метки для
фасетов различны, поскольку им должны быть присвоены разные степени пропусков и плотности выборкидля переменной
‘grpA’.

 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)

}

  

Вот моя проблема — когда я печатаю графики, которые хранятся в списке,
все они, похоже, сохраняют метку фасета с последнего графика, вместо того, чтобы сохранять
отдельные метки фасетов, которые они отображали при первоначальном создании.

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

В принципе, я хотел бы иметь возможность печатать графики из списка
, когда они мне понадобятся, и отображать их отдельные метки фасетов
так, как они отображались при первоначальном создании графиков.

Возможно, кто-нибудь из сообщества мог бы мне помочь?

Я бы посоветовал вам попытаться избежать цикла для построения графиков. Он используется для создания таких проблем, как у вас с метками или иногда с данными. Здесь я упаковал ваш цикл в функцию и сохранил результаты в списке. Кроме того, вы можете использовать lapply() с именами ваших данных, чтобы напрямую создавать список с графиками. Здесь код:

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

Теперь мы создаем список:

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

Наконец, графики, которые вы использовали в последнем цикле:

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

Выводит:

Проблема в том, что ваша my_label функция имеет свободную переменную lookup , которая разрешается только при фактическом построении функции. После выполнения цикла for-loop он содержит только последнее значение в цикле. Чтобы зафиксировать текущее значение цикла, вы можете поместить его во вложении. Таким образом, вы могли бы изменить my_label функцию на

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

и затем вызовите facet_grid с

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

Но я согласен с @Duck, что избежать цикла for в этом случае было бы проще.