lee*_*sej 10 r dplyr lazyeval tidyverse rlang
我正在尝试编写一个函数tidyverse/dplyr,我想最终使用lapply(或map).(我一直在努力回答这个问题,但发现了一个有趣的结果/死胡同.请不要将其标记为重复 - 这个问题是你在那里看到的答案的延伸/背离.)
是否有
1)获取引用变量列表以在dplyr函数内工作
(并且不使用已弃用的SE_函数)的方法, 或者是
2)某种方式通过一个lapply或多个方式提供一个未加引号的字符串列表map
我使用Programming in Dplyr小插图来构建我认为最符合当前使用NSE标准的功能.
sample_data <-
read.table(text = "REVENUEID AMOUNT YEAR REPORT_CODE PAYMENT_METHOD INBOUND_CHANNEL AMOUNT_CAT
1 rev-24985629 30 FY18 S Check Mail 25,50
2 rev-22812413 1 FY16 Q Other Canvassing 0.01,10
3 rev-23508794 100 FY17 Q Credit_card Web 100,250
4 rev-23506121 300 FY17 S Credit_card Mail 250,500
5 rev-23550444 100 FY17 S Credit_card Web 100,250
6 rev-21508672 25 FY14 J Check Mail 25,50
7 rev-24981769 500 FY18 S Credit_card Web 500,1e+03
8 rev-23503684 50 FY17 R Check Mail 50,75
9 rev-24982087 25 FY18 R Check Mail 25,50
10 rev-24979834 50 FY18 R Credit_card Web 50,75
", header = TRUE, stringsAsFactors = FALSE)
Run Code Online (Sandbox Code Playgroud)
report <- function(report_cat){
report_cat <- enquo(report_cat)
sample_data %>%
group_by(!!report_cat, YEAR) %>%
summarize(num=n(),total=sum(AMOUNT)) %>%
rename(REPORT_VALUE = !!report_cat) %>%
mutate(REPORT_CATEGORY := as.character(quote(!!report_cat))[2])
}
Run Code Online (Sandbox Code Playgroud)
这适用于生成单个报告:
Run Code Online (Sandbox Code Playgroud)> report(REPORT_CODE) # A tibble: 7 x 5 # Groups: REPORT_VALUE [4] REPORT_VALUE YEAR num total REPORT_CATEGORY <chr> <chr> <int> <int> <chr> 1 J FY14 1 25 REPORT_CODE 2 Q FY16 1 1 REPORT_CODE 3 Q FY17 1 100 REPORT_CODE 4 R FY17 1 50 REPORT_CODE 5 R FY18 2 75 REPORT_CODE 6 S FY17 2 400 REPORT_CODE 7 S FY18 2 530 REPORT_CODE
当我尝试设置要生成的所有4个报告的列表时,一切都会崩溃.(虽然不可否认,函数最后一行所需的代码 - 返回一个字符串,然后用它来填充列 - 应该足够线索以至于我已经走错了方向.)
#the other reports
cat.list <- c("REPORT_CODE","PAYMENT_METHOD","INBOUND_CHANNEL","AMOUNT_CAT")
# Applying and Mapping attempts
lapply(cat.list, report)
map_df(cat.list, report)
Run Code Online (Sandbox Code Playgroud)
结果如下:
Run Code Online (Sandbox Code Playgroud)> lapply(cat.list, report) Error in (function (x, strict = TRUE) : the argument has already been evaluated > map_df(cat.list, report) Error in (function (x, strict = TRUE) : the argument has already been evaluated
我也曾尝试移交到前字符串名称列表转换apply和map:
library(rlang)
cat.names <- lapply(cat.list, sym)
lapply(cat.names, report)
map_df(cat.names, report)
Run Code Online (Sandbox Code Playgroud)
Run Code Online (Sandbox Code Playgroud)> lapply(cat.names, report) Error in (function (x, strict = TRUE) : the argument has already been evaluated > map_df(cat.names, report) Error in (function (x, strict = TRUE) : the argument has already been evaluated
在任何情况下,我问这个问题的原因是我认为我已经将函数写入当前记录的标准,但最终我认为没有办法利用具有这种功能apply的purrr::map家庭成员甚至家庭成员.没有重写使用names像useR这样的功能/sf/answers/3312130601/有没有办法让这个功能使用apply或map?
我希望看到这个结果:
Run Code Online (Sandbox Code Playgroud)# A tibble: 27 x 5 # Groups: REPORT_VALUE [16] REPORT_VALUE YEAR num total REPORT_CATEGORY <chr> <chr> <int> <int> <chr> 1 J FY14 1 25 REPORT_CODE 2 Q FY16 1 1 REPORT_CODE 3 Q FY17 1 100 REPORT_CODE 4 R FY17 1 50 REPORT_CODE 5 R FY18 2 75 REPORT_CODE 6 S FY17 2 400 REPORT_CODE 7 S FY18 2 530 REPORT_CODE 8 Check FY14 1 25 PAYMENT_METHOD 9 Check FY17 1 50 PAYMENT_METHOD 10 Check FY18 2 55 PAYMENT_METHOD # ... with 17 more rows
as.name将字符串转换为名称,并且可以传递给report:
lapply(cat.list, function(x) do.call("report", list(as.name(x))))
Run Code Online (Sandbox Code Playgroud)
字符参数另一种方法是重写report,使其接受字符串参数:
report_ch <- function(colname) {
report_cat <- rlang::sym(colname) # as.name(colname) would also work here
sample_data %>%
group_by(!!report_cat, YEAR) %>%
summarize(num = n(), total = sum(AMOUNT)) %>%
rename(REPORT_VALUE = !!report_cat) %>%
mutate(REPORT_CATEGORY = colname)
}
lapply(cat.list, report_ch)
Run Code Online (Sandbox Code Playgroud)
wrapper另一种方法是使用wrapper包重写report,它是rlang/tidyeval的替代品:
library(dplyr)
library(wrapr)
report_wrapr <- function(colname)
let(c(COLNAME = colname),
sample_data %>%
group_by(COLNAME, YEAR) %>%
summarize(num = n(), total = sum(AMOUNT)) %>%
rename(REPORT_VALUE = COLNAME) %>%
mutate(REPORT_CATEGORY = colname)
)
lapply(cat.list, report_wrapr)
Run Code Online (Sandbox Code Playgroud)
当然,如果您使用不同的框架,整个问题就会消失,例如
普利尔
library(plyr)
report_plyr <- function(colname)
ddply(sample_data, c(REPORT_VALUE = colname, "YEAR"), function(x)
data.frame(num = nrow(x), total = sum(x$AMOUNT), REPORT_CATEOGRY = colname))
lapply(cat.list, report_plyr)
Run Code Online (Sandbox Code Playgroud)
sqldf
library(sqldf)
report_sql <- function(colname, envir = parent.frame(), ...)
fn$sqldf("select [$colname] REPORT_VALUE,
YEAR,
count(*) num,
sum(AMOUNT) total,
'$colname' REPORT_CATEGORY
from sample_data
group by [$colname], YEAR", envir = envir, ...)
lapply(cat.list, report_sql)
Run Code Online (Sandbox Code Playgroud)
基数为
report_base_by <- function(colname)
do.call("rbind",
by(sample_data, sample_data[c(colname, "YEAR")], function(x)
data.frame(REPORT_VALUE = x[1, colname],
YEAR = x$YEAR[1],
num = nrow(x),
total = sum(x$AMOUNT),
REPORT_CATEGORY = colname)
)
)
lapply(cat.list, report_base_by)
Run Code Online (Sandbox Code Playgroud)
data.table data.table 包提供了另一种选择,但另一个答案已经涵盖了。
更新:添加了其他替代方案。