在RHS上使用NSE的Dplyr中的动态列

时间：2019-07-10 21:02:41

标签： r dplyr rlang nse

我试图通过循环引用dplyr中的现有列。实际上，我想评估从一个表（以下示例中的评估）到另一张表（以下示例中的dt）的操作。我不想在mutate（）中的RHS上硬编码列名。我想控制以下评估表中正在执行的评估。因此，我正在尝试使过程动态化。

这是一个示例数据框：

dt = data.frame(
    A = c(1:20), 
    B = c(11:30), 
    C = c(21:40),
    AA = rep(1, 20), 
    BB = rep(2, 20)
)

这是要执行的示例操作表：

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”的正确语法是什么？

enter image description here

我知道还有其他使用基数R的方法，但是我宁愿通过dplyr来实现，因为它是更干净的代码。我利用“ rowise（）”逐个元素地进行操作。

4 个答案:

答案 0 :(得分：2)

假设Felipe's answer是您想要的功能，那么这是一种更加“ tidyverse” /面向管道/功能的方法。

数据

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是“矢量化”版本。它以原始数据框为第一个参数，而操作数据框为第二个参数。然后，它并行映射新变量名称，测试等的每一列，并在每一列上调用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名称和操作存储在小标题中。我认为这比用引号将名称和操作存储在字符串中要干净得多。

答案 1 :(得分：1)

这是怎么回事：

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))))

}

答案 2 :(得分：1)

修改后的数据用于（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

答案 3 :(得分：0)

一种方法是先修改条件，然后将其传递给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
相关问题
最新问题