为什么R purrr的pmap报错“仅字符串可转换为符号”且无法遍历数据集

我尝试使用purrr包的pmap函数自动化生成ggplot幻灯片，延伸之前的相关需求，需要基于数据中的分组变量level和location生成分面图。

和之前的场景不同，本次有3个输入参数，因此需要用pmap()代替map2()，但运行时一直报错：

Error: Only strings can be converted to symbols
Run `rlang::last_error()` to see where the error occurred.

回溯错误信息显示问题出在第一次pmap()调用中：

<error/rlang_error>
Only strings can be converted to symbols
Backtrace:
  1. purrr::pmap(...)
 14. rlang::sym(variable)

我尝试了各种组合都无法解决问题，期望能按level和location遍历生成所有图表。

原始代码与测试数据 #

#Packages
library(dplyr)
library(purrr)
library(ggplot2)

#Data
test <- tibble(s1 = c("Agree", "Neutral", "Strongly disagree"),
               s2rl = c("Agree", "Neutral", "Strongly disagree"),
               f1 = c("Strongly agree", "Disagree", "Strongly disagree"),
               f2rl = c("Strongly agree", "Disagree", "Strongly disagree"),
               level = c("Manager", "Employee", "Employee"),
               location = c("USA", "USA", "AUS"))

#Get just test items for name
test_items <- test %>%
  dplyr::select(s1, s2rl, f1, f2rl)

#titles of plots for R to iterate over
titles <- c("S1 results", "Results for S2RL", "Fiscal Results for F1", "Financial Status of F2RL")


#group levels
group_name <- c("level", "location")

#custom ggplot function
faceted_plots = function(variable, group, title) {

  sample_size <- test %>%
    group_by(!! rlang::sym(group), !! rlang::sym(variable)) %>%
    summarize(n = sum(!is.na(!! rlang::sym(variable))))
  

  test %>%
    count(!! rlang::sym(group), !! rlang::sym(variable)) %>%
    mutate(percent = 100*(n / sample_size$n)) %>%
    drop_na() %>%
    ggplot(aes(x = !! rlang::sym(variable), y = percent, fill = .data[[variable]])) + 
    geom_bar(stat = "identity") +
    geom_text(aes(label= paste0(percent, "%"), fontface = "bold", family = "Arial", size=14), vjust= 0, hjust = -.5) +
    ylab("\nPercentage") +
    labs(
      title = title,
      subtitle = paste0("(N = ", sample_size$n, ")")) +
    coord_flip() +
    theme_minimal() +
    scale_fill_manual(values = c("Strongly disagree" = "#CA001B", "Disagree" = "#1D28B0", "Neutral" = "#D71DA4", "Agree" = "#00A3AD", "Strongly agree" = "#FF8200")) +
    scale_x_discrete(labels = c("Strongly disagree" = "Strongly\nDisagree", "Disagree" = "Disagree", "Neutral" = "Neutral", "Agree" = "Agree", "Strongly agree" = "Strongly\nAgree"), drop = FALSE) + 
    theme(axis.title.y = element_blank(),
          axis.text = element_text(size = 14, color = "gray28", face = "bold", hjust = .5),
          axis.title.x = element_text(size = 18, color = "gray32", face = "bold"),
          legend.position = "none",
          text = element_text(family = "Arial"),
          plot.title = element_text(size = 20, color = "gray32", face = "bold", hjust = .5),
          plot.subtitle = element_text(size = 16, color = "gray32", face = "bold", hjust = .5),
          panel.spacing.x = unit(2, "lines")) +
    ylim(0, 100) +
    facet_grid(~!! rlang::sym(group))
}

#pmap call
plots_and_facet <- pmap(
  list(x = names(test_items),
       y= titles,
       z = group_name),
  faceted_plots(test_items, titles, group_name))

可行解决方案 #

注：计数逻辑问题由提问者个人导致，不在本问题讨论范围内，以下为可运行的修复后代码：

#custom ggplot function
faceted_plots = function(variable, group, title) {

  sample_size <- test %>%
    group_by(.data[[group]], .data[[variable]]) %>%
    summarize(n = sum(!is.na(.data[[variable]])))
  

  test %>%
    count(.data[[group]], .data[[variable]]) %>%
    mutate(percent = 100*(n / sample_size$n)) %>%
    drop_na() %>%
    ggplot(aes(x = .data[[variable]], y = percent, fill = .data[[variable]])) + 
    geom_bar(stat = "identity") +
    geom_text(aes(label= paste0(percent, "%"), fontface = "bold", family = "Arial", size=14), vjust= 0, hjust = -.5) +
    ylab("\nPercentage") +
    labs(
      title = title,
      subtitle = paste0("(N = ", sample_size$n, ")")) +
    coord_flip() +
    theme_minimal() +
    scale_fill_manual(values = c("Strongly disagree" = "#CA001B", "Disagree" = "#1D28B0", "Neutral" = "#D71DA4", "Agree" = "#00A3AD", "Strongly agree" = "#FF8200")) +
    scale_x_discrete(labels = c("Strongly disagree" = "Strongly\nDisagree", "Disagree" = "Disagree", "Neutral" = "Neutral", "Agree" = "Agree", "Strongly agree" = "Strongly\nAgree"), drop = FALSE) + 
    theme(axis.title.y = element_blank(),
          axis.text = element_text(size = 14, color = "gray28", face = "bold", hjust = .5),
          axis.title.x = element_text(size = 18, color = "gray32", face = "bold"),
          legend.position = "none",
          text = element_text(family = "Arial"),
          plot.title = element_text(size = 20, color = "gray32", face = "bold", hjust = .5),
          plot.subtitle = element_text(size = 16, color = "gray32", face = "bold", hjust = .5),
          panel.spacing.x = unit(2, "lines")) +
    ylim(0, 100) +
    facet_grid(~.data[[group]])
}

#pmap call
expand_grid(tibble(item = names(test_items), title=titles),
              group = group_name) %>%
  pmap(function(item, group, title)
    faceted_plots(item, group, title))

问题原因说明 #

原始代码主要存在3个问题：

1. 传入pmap的三个参数长度不一致：names(test_items)和titles长度为4，group_name长度为2，pmap默认按元素逐个配对，长度不匹配时会报错或出现非预期结果；修复方案使用expand_grid生成所有变量、标题、分组的全量组合，保证每组参数都是长度一致的三元组。
2. pmap第二个参数需要传入函数本身，而不是直接调用函数，原始代码直接写faceted_plots(test_items, titles, group_name)会提前执行函数，而非按pmap的规则逐个传入参数调用。
3. 动态变量引用的写法优化：使用.data[[变量名]]的写法代替!!rlang::sym()，写法更简洁，也避免了部分符号转换的报错。

内容的提问来源于stack exchange，提问作者J.Sabree