如何使用 purrr 函数或循环自动执行 dplyr 函数调用

How to automate a dplyr function call with a purrr function or a loop

我正在尝试自动执行函数调用,以便我可以通过旋转因变量(例如 x、y 和 z)并使用分组变量(例如年份和种族)的各种组合或单独使用来生成一个数据框,年份、种族和城市。

更详细。

在我的最小示例中,我有三个因变量,x,y,z。我还有几个分组变量。对于每个调用,我需要计算 1 的数量。我还需要添加一个新列,其中包含反映所使用的因变量的字符串值。

当我指定两个分组变量和因变量时,我能够编写一个生成计数的函数。在实际问题中,对于大约十几个因变量中的每一个,我都必须以多种不同的方式进行分组。我可能有一个、两个或三个分组变量。 在函数之外,我添加了字符列,提供有关变量是什么的信息。我认为在函数内部我应该有一个 case_when() 声明,内容如下:

case_when({{var1}} == 'x' ~ "This is the first",  
{{var1}} == 'y' ~ "Second one",  
{{var1}} == 'z' ~ "Third shot")  

然后我使用 rbind 来合并我的结果。

我有一个工作函数,我可以添加字符串列。

我的最终结果需要是一个数据框。我正在培训最终用户,即初级 R 程序员,以使用我的代码。所以简单是首选,即使这意味着使用一些功能。

我阅读了:
https://dplyr.tidyverse.org/articles/programming.html
https://adv-r.hadley.nz/functionals.html#purrr-style

但是,我不知道如何使该过程自动化,以便不同的用户可以执行一个函数调用(或者可能是两个或三个)。如果我以交互方式执行此操作,将会有数百种变量组合。 我认为这可以通过循环或 purr 函数来完成,但我无法弄明白。

library(tidyverse)  
set.seed(2021)  
numRows = 1000

df1 = data.frame(year = sample(2010:2013, size = numRows, replace = TRUE),
             race = sample(c('white', 'black', 'Asian', 'Hispanic'), size = numRows, replace = TRUE),
             city = sample(c('Oakland', 'Berkeley','Fremont'), size = numRows, replace = TRUE),
             young = sample(c(1,2,NA), size = numRows, replace = TRUE),
             old = sample(c(1,2,NA), size = numRows, replace = TRUE),
             x = sample(x = c(1,2, NA), size = numRows, replace = TRUE, prob = c(.7, .2, .1)),
             y = sample(x = c(1,2, NA), size = numRows, replace = TRUE, prob = c(.7, .2, .1)),
             z = sample(x = c(1,2, NA), size = numRows, replace = TRUE, prob = c(.7, .2, .1)))

df1$year = factor(df1$year)
df1$race = factor(df1$race)
df1$city = factor(df1$city)

# Working code
compute_num02 = function(grp1, grp2, var1) {
res_num = df1 %>%
filter(!is.na({{var1}}), {{var1}} == 1  )  %>%  
group_by({{grp1}}, {{grp2}}, .drop = FALSE) %>% summarize(counts = n()) %>% 
select({{grp1}},{{grp2}},counts) %>% as.data.frame()
res_num 
}

# Completing the code interactively
res1 = compute_num02(year, city,x)
res1$Note = "This is the first"

res2 = compute_num02(year, city,y)
res2$Note = "Second one"

res3 = compute_num02(year, city,z)
res3$Note = "Third shot"
result_final = rbind(res1,res2,res3)
result_final

如果我们想以带引号或不带引号的形式传递,我们可以使用 ensym 转换为符号并计算 (!!) 。在这里,我们只更改 'var1' 部分,分组列也可以更改(如果我们想循环超过 1 个输入,请使用 map2(对于 2 个变量输入)或 pmap(对于 >= 2))

library(purrr)
library(dplyr)
compute_num02 = function(dat, grp1, grp2, var1) {
    # // convert the inputs to symbol
    grp1 <- rlang::ensym(grp1)
    grp2 <- rlang::ensym(grp2)
    var1 <- rlang::ensym(var1)
    # // evaluate with !!
    res_num <- dat %>%
        filter(!is.na(!! var1),  !! var1 == 1  )  %>%  
        group_by(!! grp1, !! grp2, .drop = FALSE) %>%
        summarize(counts = n(), .groups = 'drop') %>% 
        select(!! grp1, !! grp2, counts) %>% 
        as.data.frame()
      res_num 
}

循环 'x'、'y'、'z in map,应用 compute_num02

map_dfr(c('x', 'y', 'z'), 
      ~ compute_num02(df1, year, city,  !!.x), .id = 'Note')

-输出

#   Note year     city counts
#1     1 2010 Berkeley     62
#2     1 2010  Fremont     58
#3     1 2010  Oakland     57
#4     1 2011 Berkeley     47
#5     1 2011  Fremont     48
#6     1 2011  Oakland     54
#7     1 2012 Berkeley     55
#8     1 2012  Fremont     70
#9     1 2012  Oakland     48
#10    1 2013 Berkeley     52
#11    1 2013  Fremont     61
#12    1 2013  Oakland     65
#13    2 2010 Berkeley     66
#14    2 2010  Fremont     62
#15    2 2010  Oakland     56
#16    2 2011 Berkeley     55
#17    2 2011  Fremont     55
#18    2 2011  Oakland     55
#19    2 2012 Berkeley     51
#20    2 2012  Fremont     65
#21    2 2012  Oakland     48
#22    2 2013 Berkeley     44
#23    2 2013  Fremont     54
#24    2 2013  Oakland     71
#25    3 2010 Berkeley     67
#26    3 2010  Fremont     63
#27    3 2010  Oakland     49
#28    3 2011 Berkeley     59
#29    3 2011  Fremont     60
#30    3 2011  Oakland     59
#31    3 2012 Berkeley     61
#32    3 2012  Fremont     64
#33    3 2012  Oakland     43
#34    3 2013 Berkeley     47
#35    3 2013  Fremont     58
#36    3 2013  Oakland     64