在 RHS 上使用 NSE 的 Dplyr 中的动态列
Dynamic Columns in Dplyr using NSE on the RHS
我试图通过循环引用 dplyr 中的现有列。实际上，我想评估从一个 table （下面示例中的评估）到另一个 table （下面示例中的 dt）执行的操作。我不想在 mutate() 中对 RHS 上的列名进行硬编码。我想控制从下面的评估 table 执行的评估。所以我试图让这个过程动态化。
这是一个示例数据框：
dt = data.frame(
A = c(1:20),
B = c(11:30),
C = c(21:40),
AA = rep(1, 20),
BB = rep(2, 20)
)
这里是要执行的示例操作 table：
evaluation = data.frame(
New_Var = c("AA", "BB"),
Operation = c("(A*2) > B", "(B*2) <= C"),
Result = c("True", "False")
) %>% mutate_all(as.character)
我想做的是：
for (i in 1:nrow(evaluation)) {
var = evaluation$New_Var[i]
dt = dt %>%
rowwise() %>%
mutate(!!var := ifelse(eval(parse(text = evaluation$Operation[i])),
evaluation$Result[i],
!!var))
}
我想要的结果是这样的，除了 AA 列中的 "AA" 将是 AA 列的原始数值 1, 1, 1, 1, 1。
更新：
我认为我在 ifelse 语句的 "False" 部分的语法不正确。在 ifelse 语句的错误部分指定“!!var”的正确语法是什么？
我知道还有其他方法可以使用 base R 来完成它，但我宁愿通过 dplyr 来完成它，因为它是更清晰的代码。我正在利用 "rowise()" 逐个元素地进行。
怎么样：
evaluation = data.frame(
Old_Var = c('A', 'B'),
New_Var = c("AA", "BB"),
Operation = c("(A*2) > B", "(B*2) <= C"),
Result = c("True", "False")
) %>% mutate_all(as.character)
for (i in 1:nrow(evaluation)) {
old <- sym(evaluation$Old_Var[i])
new <- sym(evaluation$New_Var[i])
op <- sym(evaluation$Operation[i])
res <- sym(evaluation$Result[i])
dt <- dt %>%
mutate(!!new := ifelse(!!op, !!res, !!old))
}
编辑： 我的最后一个答案不起作用，因为 rlang 试图找到一个名为 !!op 的变量（例如，名为 (A*2) > B）而不是评估表达。我使用 tidyselect 和 base R 的组合使它工作。您当然可以遵循@Brian 的建议并将此解决方案与 pmap 一起使用。老实说，我不知道这会有多好，因为我认为它会每行评估一次 ifelse，并且我不确定它是一个矢量化操作...
dt <- tibble(
A = c(1:20),
B = c(11:30),
C = c(21:40),
AA = rep(1, 20),
BB = rep(2, 20)
)
evaluation = tibble(
Old_Var = c('A', 'B'),
New_Var = c("AA", "BB"),
Operation = c('(A*2) > B', '(B*2) <= C'),
Result = c("True", "False")
)
for (i in 1:nrow(evaluation)) {
old <- evaluation$Old_Var[i]
new <- evaluation$New_Var[i]
op <- evaluation$Operation[i]
res <- evaluation$Result[i]
dt <- dt %>%
mutate(!!sym(new) := eval(parse(text = sprintf('ifelse(%s, "%s", %s)', op, res, old))))
}
假设 是您想要的功能，这里有一个更 "tidyverse"/pipe-oriented/functional 的方法。
数据
library(rlang)
library(dplyr)
library(purrr)
operations <- tibble(
old_var = exprs(A, B),
new_var = exprs(AA, BB),
test = exprs(2*A > B, 2*B <= C),
result = exprs("True", "False")
)
original <- tibble(
A = sample.int(30, 10),
B = sample.int(30, 10),
C = sample.int(30, 10)
)
original
# A tibble: 10 x 3
A B C
<int> <int> <int>
1 4 20 5
2 30 29 11
3 1 27 14
4 2 21 4
5 17 19 24
6 14 25 9
7 5 22 22
8 6 13 7
9 25 4 21
10 12 11 12
函数
# Here's your reusable functions
generic_mutate <- function(dat, new_var, test, result, old_var) {
dat %>% mutate(!!new_var := ifelse(!!test, !!result, !!old_var))
}
generic_ops <- function(dat, ops) {
pmap(ops, generic_mutate, dat = dat) %>%
reduce(full_join)
}
generic_mutate 采用单个原始数据帧、单个 new_var 等。它执行测试，添加具有适当名称和值的新列。
generic_ops 是 "vectorized" 版本。它以原始数据帧作为第一个参数，将操作数据帧作为第二个参数。然后它并行映射新变量名称、测试等的每一列，并在每个列上调用 generic_mutate。这会产生一个数据框列表，每个数据框都有一个添加的列。 reduce 然后将它们与顺序的 full_join.
组合在一起
结果
original %>%
generic_ops(operations)
Joining, by = c("A", "B", "C")
# A tibble: 10 x 5
A B C AA BB
<int> <int> <int> <chr> <chr>
1 4 20 5 4 20
2 30 29 11 True 29
3 1 27 14 1 27
4 2 21 4 2 21
5 17 19 24 True 19
6 14 25 9 True 25
7 5 22 22 5 22
8 6 13 7 6 13
9 25 4 21 True False
10 12 11 12 True 11
这里的神奇之处在于使用 exprs(...)，因此您可以将 NSE 名称和操作存储在 tibble 中，而无需强制对其求值。我认为这比在带引号的字符串中存储名称和操作要干净得多。
修改数据 以 (a) 强制列 AA 和 BB 的类型一致性，以及 (b) 确保至少一行满足第二行条件。
dt = tibble(
A = c(1:20),
B = c(10:29), ## Note the change
C = c(21:40),
AA = rep("a", 20), ## Note initialization with strings
BB = rep("b", 20) ## Ditto
)
要使循环工作，您需要将代码字符串转换为实际的表达式。您可以使用 rlang::sym() 作为变量名称，使用 rlang::parse_expr() 作为其他名称。
for( i in 1:nrow(evaluation) )
{
var <- rlang::sym(evaluation$New_Var[i])
op <- rlang::parse_expr(evaluation$Operation[i])
dt = dt %>% rowwise() %>%
mutate(!!var := ifelse(!!op, evaluation$Result[i],!!var))
}
# # A tibble: 20 x 5
# A B C AA BB
# <int> <int> <int> <chr> <chr>
# 1 1 10 21 a False
# 2 2 11 22 a False
# 3 3 12 23 a b
# 4 4 13 24 a b
# 5 5 14 25 a b
# 6 6 15 26 a b
# 7 7 16 27 a b
# 8 8 17 28 a b
# 9 9 18 29 a b
# 10 10 19 30 True b
# 11 11 20 31 True b
# 12 12 21 32 True b
# 13 13 22 33 True b
# 14 14 23 34 True b
# 15 15 24 35 True b
# 16 16 25 36 True b
# 17 17 26 37 True b
# 18 18 27 38 True b
# 19 19 28 39 True b
# 20 20 29 40 True b
一种方法是先修改条件，然后将它们传递给 mutate：
conds <- parse(text=evaluation$Operation) %>%
as.list() %>%
setNames(evaluation$New_Var) %>%
imap(~expr(ifelse(!!.,"True", !!sym(.y))))
conds
#> $AA
#> ifelse((A * 2) > B, "True", AA)
#>
#> $BB
#> ifelse((B * 2) <= C, "True", BB)
dt %>% mutate(!!!conds)
#> A B C AA BB
#> 1 1 11 21 1 2
#> 2 2 12 22 1 2
#> 3 3 13 23 1 2
#> 4 4 14 24 1 2
#> 5 5 15 25 1 2
#> 6 6 16 26 1 2
#> 7 7 17 27 1 2
#> 8 8 18 28 1 2
#> 9 9 19 29 1 2
#> 10 10 20 30 1 2
#> 11 11 21 31 True 2
#> 12 12 22 32 True 2
#> 13 13 23 33 True 2
#> 14 14 24 34 True 2
#> 15 15 25 35 True 2
#> 16 16 26 36 True 2
#> 17 17 27 37 True 2
#> 18 18 28 38 True 2
#> 19 19 29 39 True 2
#> 20 20 30 40 True 2
我试图通过循环引用 dplyr 中的现有列。实际上，我想评估从一个 table （下面示例中的评估）到另一个 table （下面示例中的 dt）执行的操作。我不想在 mutate() 中对 RHS 上的列名进行硬编码。我想控制从下面的评估 table 执行的评估。所以我试图让这个过程动态化。
这是一个示例数据框：
dt = data.frame(
A = c(1:20),
B = c(11:30),
C = c(21:40),
AA = rep(1, 20),
BB = rep(2, 20)
)
这里是要执行的示例操作 table：
evaluation = data.frame(
New_Var = c("AA", "BB"),
Operation = c("(A*2) > B", "(B*2) <= C"),
Result = c("True", "False")
) %>% mutate_all(as.character)
我想做的是：
for (i in 1:nrow(evaluation)) {
var = evaluation$New_Var[i]
dt = dt %>%
rowwise() %>%
mutate(!!var := ifelse(eval(parse(text = evaluation$Operation[i])),
evaluation$Result[i],
!!var))
}
我想要的结果是这样的，除了 AA 列中的 "AA" 将是 AA 列的原始数值 1, 1, 1, 1, 1。
更新：
我认为我在 ifelse 语句的 "False" 部分的语法不正确。在 ifelse 语句的错误部分指定“!!var”的正确语法是什么？
我知道还有其他方法可以使用 base R 来完成它，但我宁愿通过 dplyr 来完成它，因为它是更清晰的代码。我正在利用 "rowise()" 逐个元素地进行。
怎么样：
evaluation = data.frame(
Old_Var = c('A', 'B'),
New_Var = c("AA", "BB"),
Operation = c("(A*2) > B", "(B*2) <= C"),
Result = c("True", "False")
) %>% mutate_all(as.character)
for (i in 1:nrow(evaluation)) {
old <- sym(evaluation$Old_Var[i])
new <- sym(evaluation$New_Var[i])
op <- sym(evaluation$Operation[i])
res <- sym(evaluation$Result[i])
dt <- dt %>%
mutate(!!new := ifelse(!!op, !!res, !!old))
}
编辑： 我的最后一个答案不起作用，因为 rlang 试图找到一个名为 !!op 的变量（例如，名为 (A*2) > B）而不是评估表达。我使用 tidyselect 和 base R 的组合使它工作。您当然可以遵循@Brian 的建议并将此解决方案与 pmap 一起使用。老实说，我不知道这会有多好，因为我认为它会每行评估一次 ifelse，并且我不确定它是一个矢量化操作...
dt <- tibble(
A = c(1:20),
B = c(11:30),
C = c(21:40),
AA = rep(1, 20),
BB = rep(2, 20)
)
evaluation = tibble(
Old_Var = c('A', 'B'),
New_Var = c("AA", "BB"),
Operation = c('(A*2) > B', '(B*2) <= C'),
Result = c("True", "False")
)
for (i in 1:nrow(evaluation)) {
old <- evaluation$Old_Var[i]
new <- evaluation$New_Var[i]
op <- evaluation$Operation[i]
res <- evaluation$Result[i]
dt <- dt %>%
mutate(!!sym(new) := eval(parse(text = sprintf('ifelse(%s, "%s", %s)', op, res, old))))
}
假设
数据
library(rlang)
library(dplyr)
library(purrr)
operations <- tibble(
old_var = exprs(A, B),
new_var = exprs(AA, BB),
test = exprs(2*A > B, 2*B <= C),
result = exprs("True", "False")
)
original <- tibble(
A = sample.int(30, 10),
B = sample.int(30, 10),
C = sample.int(30, 10)
)
original
# A tibble: 10 x 3 A B C <int> <int> <int> 1 4 20 5 2 30 29 11 3 1 27 14 4 2 21 4 5 17 19 24 6 14 25 9 7 5 22 22 8 6 13 7 9 25 4 21 10 12 11 12
函数
# Here's your reusable functions
generic_mutate <- function(dat, new_var, test, result, old_var) {
dat %>% mutate(!!new_var := ifelse(!!test, !!result, !!old_var))
}
generic_ops <- function(dat, ops) {
pmap(ops, generic_mutate, dat = dat) %>%
reduce(full_join)
}
generic_mutate 采用单个原始数据帧、单个 new_var 等。它执行测试，添加具有适当名称和值的新列。
generic_ops 是 "vectorized" 版本。它以原始数据帧作为第一个参数，将操作数据帧作为第二个参数。然后它并行映射新变量名称、测试等的每一列，并在每个列上调用 generic_mutate。这会产生一个数据框列表，每个数据框都有一个添加的列。 reduce 然后将它们与顺序的 full_join.
结果
original %>%
generic_ops(operations)
Joining, by = c("A", "B", "C") # A tibble: 10 x 5 A B C AA BB <int> <int> <int> <chr> <chr> 1 4 20 5 4 20 2 30 29 11 True 29 3 1 27 14 1 27 4 2 21 4 2 21 5 17 19 24 True 19 6 14 25 9 True 25 7 5 22 22 5 22 8 6 13 7 6 13 9 25 4 21 True False 10 12 11 12 True 11
这里的神奇之处在于使用 exprs(...)，因此您可以将 NSE 名称和操作存储在 tibble 中，而无需强制对其求值。我认为这比在带引号的字符串中存储名称和操作要干净得多。
修改数据 以 (a) 强制列 AA 和 BB 的类型一致性，以及 (b) 确保至少一行满足第二行条件。
dt = tibble(
A = c(1:20),
B = c(10:29), ## Note the change
C = c(21:40),
AA = rep("a", 20), ## Note initialization with strings
BB = rep("b", 20) ## Ditto
)
要使循环工作，您需要将代码字符串转换为实际的表达式。您可以使用 rlang::sym() 作为变量名称，使用 rlang::parse_expr() 作为其他名称。
for( i in 1:nrow(evaluation) )
{
var <- rlang::sym(evaluation$New_Var[i])
op <- rlang::parse_expr(evaluation$Operation[i])
dt = dt %>% rowwise() %>%
mutate(!!var := ifelse(!!op, evaluation$Result[i],!!var))
}
# # A tibble: 20 x 5
# A B C AA BB
# <int> <int> <int> <chr> <chr>
# 1 1 10 21 a False
# 2 2 11 22 a False
# 3 3 12 23 a b
# 4 4 13 24 a b
# 5 5 14 25 a b
# 6 6 15 26 a b
# 7 7 16 27 a b
# 8 8 17 28 a b
# 9 9 18 29 a b
# 10 10 19 30 True b
# 11 11 20 31 True b
# 12 12 21 32 True b
# 13 13 22 33 True b
# 14 14 23 34 True b
# 15 15 24 35 True b
# 16 16 25 36 True b
# 17 17 26 37 True b
# 18 18 27 38 True b
# 19 19 28 39 True b
# 20 20 29 40 True b
一种方法是先修改条件，然后将它们传递给 mutate：
conds <- parse(text=evaluation$Operation) %>%
as.list() %>%
setNames(evaluation$New_Var) %>%
imap(~expr(ifelse(!!.,"True", !!sym(.y))))
conds
#> $AA
#> ifelse((A * 2) > B, "True", AA)
#>
#> $BB
#> ifelse((B * 2) <= C, "True", BB)
dt %>% mutate(!!!conds)
#> A B C AA BB
#> 1 1 11 21 1 2
#> 2 2 12 22 1 2
#> 3 3 13 23 1 2
#> 4 4 14 24 1 2
#> 5 5 15 25 1 2
#> 6 6 16 26 1 2
#> 7 7 17 27 1 2
#> 8 8 18 28 1 2
#> 9 9 19 29 1 2
#> 10 10 20 30 1 2
#> 11 11 21 31 True 2
#> 12 12 22 32 True 2
#> 13 13 23 33 True 2
#> 14 14 24 34 True 2
#> 15 15 25 35 True 2
#> 16 16 26 36 True 2
#> 17 17 27 37 True 2
#> 18 18 28 38 True 2
#> 19 19 29 39 True 2
#> 20 20 30 40 True 2