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这样我就可以动态更改绘图顶部的分组变量和标签。我尝试更改 plusN()函数使用 enquo()在 'string'参数，然后更改 'grpA'至 gvar在 labeller()功能，但现在刻面标签根本不出现:

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