在 dplyr 函数中创建和访问动态列名
creating and accessing dynamic column names within dplyr functions
library(rlang)
library(dplyr)
library(lubridate)
example = tibble(
date = today() + c(1:6),
foo = rnorm(6),
)
do.some.stuff <- function(data, foo.col){
sum.col = parse_expr(paste(expr_text(enexpr(foo.col)), "sum", sep="."))
max.col = parse_expr(paste(expr_text(enexpr(foo.col)), "max", sep="."))
cnt.col = parse_expr(paste(expr_text(enexpr(foo.col)), "cnt", sep="."))
select(data, date, {{ foo.col }}) %>%
filter(!is.na(date) & !is.na({{ foo.col }})) %>% mutate(
"{{ foo.col }}.cnt" := cumsum( !is.na({{ foo.col }}) ),
"{{ foo.col }}.sum" := cumsum({{ foo.col }}),
"{{ foo.col }}.max" := cummax( {{ sum.col }} ),
"{{ foo.col }}.mu" := {{ sum.col }} / {{ cnt.col }}
)
}
do.some.stuff(example, foo)
所以上面的代码工作得很好,但有点难看,尤其是三行 parse_expr
。我可以将函数重写为:
do.some.stuff <- function(data, foo.col){
sum.col = paste(expr_text(enexpr(foo.col)), "sum", sep=".")
max.col = paste(expr_text(enexpr(foo.col)), "max", sep=".")
cnt.col = paste(expr_text(enexpr(foo.col)), "cnt", sep=".")
select(data, date, {{ foo.col }}) %>%
filter(!is.na(date) & !is.na({{ foo.col }})) %>% mutate(
cnt.col := cumsum( !is.na({{ foo.col }}) ),
sum.col := cumsum({{ foo.col }}),
max.col := cummax( {{ parse_expr(sum.col) }} ),
"{{ foo.col }}.mu" := {{ parse_expr(sum.col) }} / {{ parse_expr(cnt.col) }}
)
}
但也好不到哪儿去。有没有其他方法可以完成同样的行为(我不想改变 df 的形状,那部分不取决于我)但踢 rlang 依赖?这现在工作得很好,但如果可能的话,我想要更清晰/更容易阅读的东西。如果不是很明显,尽管我确实有其他语言的经验,但我对 R 中的元编程还是陌生的。
这可能是
的更简单版本
library(rlang)
library(dplyr)
library(lubridate)
example = tibble(
date = today() + c(1:6),
foo = rnorm(6),
)
# This is your initial version of the code.
do.some.stuff <- function(data, foo.col){
sum.col = parse_expr(paste(expr_text(enexpr(foo.col)), "sum", sep="."))
max.col = parse_expr(paste(expr_text(enexpr(foo.col)), "max", sep="."))
cnt.col = parse_expr(paste(expr_text(enexpr(foo.col)), "cnt", sep="."))
select(data, date, {{ foo.col }}) %>%
filter(!is.na(date) & !is.na({{ foo.col }})) %>% mutate(
"{{ foo.col }}.cnt" := cumsum( !is.na({{ foo.col }}) ),
"{{ foo.col }}.sum" := cumsum({{ foo.col }}),
"{{ foo.col }}.max" := cummax( {{ sum.col }} ),
"{{ foo.col }}.mu" := {{ sum.col }} / {{ cnt.col }}
)
}
# Here is my version where foo.col is a character param
do.some.stuff_2 <- function(data, foo.col) {
data %>% select(date, !!foo.col) %>%
filter(!is.na(date) & !is.na(!!foo.col)) %>%
mutate(
# Here as foo.col is a character to add new column just combine them together
!!paste0(foo.col, ".cnt") := cumsum(!is.na(.data[[foo.col]])),
!!paste0(foo.col, ".sum") := cumsum(.data[[foo.col]]),
!!paste0(foo.col, ".max") := cummax(.data[[paste0(foo.col, ".sum")]]),
!!paste0(foo.col, ".mu") := .data[[paste0(foo.col, ".sum")]] /
.data[[paste0(foo.col, ".cnt")]]
)
}
identical(do.some.stuff(example, foo), do.some.stuff_2(example, "foo"))
您可以在此处了解更多信息:https://dplyr.tidyverse.org/articles/programming.html
将 across
与 .names
参数一起使用,或者如果 foo_cnt 等带有下划线是可以的,那么只需省略 .names
参数,因为这是默认值。
library(dplyr)
library(tibble)
do.some.stuff.2 <- function(data, col) {
cnt <- function(x) cumsum(!is.na(x))
mx <- function(x) cummax(cumsum(x))
mu <- function(x) cumsum(x) / cnt(x)
data %>%
select(date, {{col}}) %>%
filter(!is.na(date) & !is.na({{col}})) %>%
mutate(across({{col}}, lst(cnt, sum=cumsum, max=mx, mu), .names = "{.col}.{.fn}" ))
}
# test
do.some.stuff.2(example, foo)
给予:
# A tibble: 6 x 6
date foo foo.cnt foo.sum foo.max foo.mu
<date> <dbl> <int> <dbl> <dbl> <dbl>
1 2021-02-11 -0.000202 1 -0.000202 -0.000202 -0.000202
2 2021-02-12 0.363 2 0.363 0.363 0.181
3 2021-02-13 1.27 3 1.63 1.63 0.543
4 2021-02-14 1.50 4 3.13 3.13 0.781
5 2021-02-15 1.00 5 4.13 4.13 0.826
6 2021-02-16 -0.458 6 3.67 4.13 0.612
library(rlang)
library(dplyr)
library(lubridate)
example = tibble(
date = today() + c(1:6),
foo = rnorm(6),
)
do.some.stuff <- function(data, foo.col){
sum.col = parse_expr(paste(expr_text(enexpr(foo.col)), "sum", sep="."))
max.col = parse_expr(paste(expr_text(enexpr(foo.col)), "max", sep="."))
cnt.col = parse_expr(paste(expr_text(enexpr(foo.col)), "cnt", sep="."))
select(data, date, {{ foo.col }}) %>%
filter(!is.na(date) & !is.na({{ foo.col }})) %>% mutate(
"{{ foo.col }}.cnt" := cumsum( !is.na({{ foo.col }}) ),
"{{ foo.col }}.sum" := cumsum({{ foo.col }}),
"{{ foo.col }}.max" := cummax( {{ sum.col }} ),
"{{ foo.col }}.mu" := {{ sum.col }} / {{ cnt.col }}
)
}
do.some.stuff(example, foo)
所以上面的代码工作得很好,但有点难看,尤其是三行 parse_expr
。我可以将函数重写为:
do.some.stuff <- function(data, foo.col){
sum.col = paste(expr_text(enexpr(foo.col)), "sum", sep=".")
max.col = paste(expr_text(enexpr(foo.col)), "max", sep=".")
cnt.col = paste(expr_text(enexpr(foo.col)), "cnt", sep=".")
select(data, date, {{ foo.col }}) %>%
filter(!is.na(date) & !is.na({{ foo.col }})) %>% mutate(
cnt.col := cumsum( !is.na({{ foo.col }}) ),
sum.col := cumsum({{ foo.col }}),
max.col := cummax( {{ parse_expr(sum.col) }} ),
"{{ foo.col }}.mu" := {{ parse_expr(sum.col) }} / {{ parse_expr(cnt.col) }}
)
}
但也好不到哪儿去。有没有其他方法可以完成同样的行为(我不想改变 df 的形状,那部分不取决于我)但踢 rlang 依赖?这现在工作得很好,但如果可能的话,我想要更清晰/更容易阅读的东西。如果不是很明显,尽管我确实有其他语言的经验,但我对 R 中的元编程还是陌生的。
这可能是
的更简单版本library(rlang)
library(dplyr)
library(lubridate)
example = tibble(
date = today() + c(1:6),
foo = rnorm(6),
)
# This is your initial version of the code.
do.some.stuff <- function(data, foo.col){
sum.col = parse_expr(paste(expr_text(enexpr(foo.col)), "sum", sep="."))
max.col = parse_expr(paste(expr_text(enexpr(foo.col)), "max", sep="."))
cnt.col = parse_expr(paste(expr_text(enexpr(foo.col)), "cnt", sep="."))
select(data, date, {{ foo.col }}) %>%
filter(!is.na(date) & !is.na({{ foo.col }})) %>% mutate(
"{{ foo.col }}.cnt" := cumsum( !is.na({{ foo.col }}) ),
"{{ foo.col }}.sum" := cumsum({{ foo.col }}),
"{{ foo.col }}.max" := cummax( {{ sum.col }} ),
"{{ foo.col }}.mu" := {{ sum.col }} / {{ cnt.col }}
)
}
# Here is my version where foo.col is a character param
do.some.stuff_2 <- function(data, foo.col) {
data %>% select(date, !!foo.col) %>%
filter(!is.na(date) & !is.na(!!foo.col)) %>%
mutate(
# Here as foo.col is a character to add new column just combine them together
!!paste0(foo.col, ".cnt") := cumsum(!is.na(.data[[foo.col]])),
!!paste0(foo.col, ".sum") := cumsum(.data[[foo.col]]),
!!paste0(foo.col, ".max") := cummax(.data[[paste0(foo.col, ".sum")]]),
!!paste0(foo.col, ".mu") := .data[[paste0(foo.col, ".sum")]] /
.data[[paste0(foo.col, ".cnt")]]
)
}
identical(do.some.stuff(example, foo), do.some.stuff_2(example, "foo"))
您可以在此处了解更多信息:https://dplyr.tidyverse.org/articles/programming.html
将 across
与 .names
参数一起使用,或者如果 foo_cnt 等带有下划线是可以的,那么只需省略 .names
参数,因为这是默认值。
library(dplyr)
library(tibble)
do.some.stuff.2 <- function(data, col) {
cnt <- function(x) cumsum(!is.na(x))
mx <- function(x) cummax(cumsum(x))
mu <- function(x) cumsum(x) / cnt(x)
data %>%
select(date, {{col}}) %>%
filter(!is.na(date) & !is.na({{col}})) %>%
mutate(across({{col}}, lst(cnt, sum=cumsum, max=mx, mu), .names = "{.col}.{.fn}" ))
}
# test
do.some.stuff.2(example, foo)
给予:
# A tibble: 6 x 6
date foo foo.cnt foo.sum foo.max foo.mu
<date> <dbl> <int> <dbl> <dbl> <dbl>
1 2021-02-11 -0.000202 1 -0.000202 -0.000202 -0.000202
2 2021-02-12 0.363 2 0.363 0.363 0.181
3 2021-02-13 1.27 3 1.63 1.63 0.543
4 2021-02-14 1.50 4 3.13 3.13 0.781
5 2021-02-15 1.00 5 4.13 4.13 0.826
6 2021-02-16 -0.458 6 3.67 4.13 0.612