Tidyeval 拥抱不适用于默认值

Question

我有一个函数 perc_diff，我在 dplyr 的 mutate 中使用它。默认情况下，它计算与组中第一个值的相对差异。但它也可以与mean、max、nth 或任何返回一个值以比较其他值的函数一起使用。

perc_diff <- function(num, fun = first, ...) {
    (num - fun(num, ...)) / fun(num, ...) * 100
}

有时，我需要更好地控制要与哪个组进行比较。在这种情况下，我通过检测模式来订购 data.frame，然后使用first。

test_data <- data.frame(group = paste0("group_", rep(LETTERS[1:3], 3)), value = 1:9, other = rep(1:3, each = 3)) %>%
arrange(rnorm(9)) 

test_data %>%
group_by(other) %>%
arrange(other, desc(str_detect(group, "A$"))) %>%
mutate(pdiff = perc_diff(value))

如果找不到控制组，我想跳过安排步骤并将其构建到函数中，并让它返回 NA。我创建了一个get_control_value 函数，perc_diff 可以使用它来代替first。我使用了 dplyr 编程的拥抱技术来获取测试组列。

get_control_value <- function(value, test_group_column = test_group, control_group_pattern = "A$") {
    test_vector <- stringr::str_detect({{test_group_column}}, control_group_pattern)
    if (sum(test_vector) == 1) {
        value[test_vector]
    } else {
        NA
    }
}

如果我给它test_group_column 的值，它会很好用。

test_data %>%
group_by(other) %>%
mutate(pdiff = perc_diff(value, get_control_value, test_group_column = group)) %>%
arrange(other, group)

但它不适用于默认值。

test_data %>%
rename(group = test_group) %>%
group_by(other) %>%
mutate(pdiff = perc_diff(value, get_control_value)) %>%
arrange(other, group)

我的问题是 - 为什么它不适用于默认值？我猜这与str_detect 不是适当的准引用上下文有关。但是，如果我手动给它赋值，为什么它会起作用呢？因为我是在mutate 内做的？

无论如何，我知道有很多方法可以解决这个问题，第一种是跳过默认值并始终输入它。但我仍然想知道是否有某种方法可以指定默认值，所以它会也可以工作。

Answer 1

想想如果你只打电话会发生什么

perc_diff(5, get_control_value)

默认值是多少？没有mutate()，所以没有名为“test_group”的列。正如所写，perc_diff 函数并不知道它应该在mutate() 中运行。它不知道“数据上下文”。 get_control_value 函数无法查找组的值。由于str_detect 不理解quasinotation，传递{{test_group}} 与传递test_group 是一样的。大括号什么都不做。就像 {{5}} 在 rlang 语法之外与 5 相同。你可以去掉大括号，它的行为也是一样的。

当你打电话时

perc_diff(value, get_control_value, test_group_column = group)

您不是在传递列的名称，而是在传递列的值。 （同样，因为{{}} 对str_detect 没有任何作用）。当您在 R 中调用函数时，会根据词法范围查找变量。这意味着值来自定义函数的地方，而不是调用它们的地方。这意味着您希望 mutate() 中的函数使用的所有值都需要传入。被调用的函数无权访问数据框，因为它不属于词法范围树。

由于函数的嵌套方式，要向上遍历调用堆栈来查找数据可能来自哪里并不容易。所以规则是，如果您的函数需要数据框中的值，则需要将它们作为参数传递。

但在这种特殊情况下，您可以在技术上做到

get_control_value <- function(value, test_group_column = eval.parent(quote(test_group), 2), control_group_pattern = "A$") {
  test_vector <- stringr::str_detect(test_group_column, control_group_pattern)
  if (sum(test_vector) == 1) {
    value[test_vector]
  } else {
    NA
  }
}

这会在调用堆栈中上升，但这确实是一个 hack。函数调用的嵌套不一定得到保证，它会阻止您在任何其他上下文中调用函数。