r - R 中 facet_grid() 的 labeller() 函数内的 tidy_eval

Question

我之前发布过这个question还有这个one这可能会为这个问题提供更多背景信息。

上下文数据:

library(tidyverse)
library(rlang)

set.seed(1)
dfr2 <- tibble(x1 = factor(sample(letters[1:3], 50, replace = T), levels=letters[1:3]),
             x2 = factor(sample(letters[1:2], 50, replace = T), levels=letters[1:2]),
             x3 = factor(sample(letters[1:3], 50, replace = T), levels=letters[1:3]),
             grpA = factor(sample(c("grp1","grp2"),50, prob=c(0.3, 0.7) ,replace=T), levels = c("grp1", "grp2")),
             grpB = factor(sample(c("grp1","grp2"),50, prob=c(0.6, 0.4) ,replace=T), levels = c("grp1", "grp2"))
             )

head(dfr2)

数据准备函数，我在其中计算用于绘图的变量以及分组变量的组总数:grp_tot

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 = dfr2, groupvar = "grpA", mainvar = "x1")

在下面的 labeller() 函数中，我必须显式键入 'grpA' 才能使代码正常工作。虽然这会产生具有适当标签的构面标签的所需结果，但这不是我想要的，因为如果我要循环分组变量，它将阻止我动态更改分组变量:

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

  lookup <- unique(dd$grp_tot)

  plusN <- function(string) {
    
    label <- paste0(string, ' (N = ',lookup,')')
    label
  }
  
    plot <- ggplot(dd, 
                   aes(x = !!smvar,y = pct2, fill = !!smvar)) +
      geom_bar(stat = 'identity') +
      ylim(0,1) +
      geom_text(aes(label=pct_lab, y = pct_pos + .02)) +
      facet_grid(as.formula(paste0(".~", gvar)), labeller = labeller(grpA = plusN))
      
    print(plot)
      
  }

相反，我希望能够使用带引号的符号 gvar ，以便我可以动态更改绘图顶部的分组变量和标签。我尝试通过在 'string' 参数上使用 enquo() 来更改 plusN() 函数，然后更改 'grpA' 到 labeller() 函数中的 gvar，但现在分面标签根本不出现:

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

  lookup <- unique(dd$grp_tot)

  plusN <- function(string) {
    
    enquo(string)
    
    label <- paste0(!!string, ' (N = ',lookup,')')
    label
  }
  
    plot <- ggplot(dd, 
                   aes(x = !!smvar,y = pct2, fill = !!smvar)) +
      geom_bar(stat = 'identity') +
      ylim(0,1) +
      geom_text(aes(label=pct_lab, y = pct_pos + .02)) +
      facet_grid(as.formula(paste0(".~", gvar)), labeller = labeller(gvar = plusN))
      
    print(plot)
      
  }

也许有人可以帮助我解决我的问题。

谢谢。

Answer 1

据我所知，解决您问题的一种方法是使用 labeller 函数，因为 facet_grid 将 df 传递给 labeller 函数，其中列df 的名称是分面变量的名称。试试这个:

试试这个:

for(mvar in names(dfr2)[1:1]) {
  
  smvar <- sym(mvar)
  
  gvar <- names(dfr2[4])
  sgvar <- sym(gvar)
  
  dd <- plot_data_prepr(dat = dfr2, groupvar = gvar, mainvar = mvar)
  
  lookup <- unique(dd$grp_tot)

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