想象一下以下数据:
data <- tribble(
~a1, ~a2, ~b1, ~b2, ~c1, ~c2,
32, 32, 50, 12, 12, 50,
48, 20, 55, 43, 10, 42
)
Run Code Online (Sandbox Code Playgroud)
对于 i = {1, 2} 我想计算deltai = (ai - ci) / ((ai + bi) * ci + ai)。
(我明确使用随机数和随机函数;通过识别和利用某些模式无法找到解决方案。)
最简单的方法是
data <- data %>%
mutate(
delta1 = (a1 - c1) / ((a1 + b1) * c1 + a1),
delta2 = (a2 - c2) / ((a2 + b2) * c2 + a2)
)
Run Code Online (Sandbox Code Playgroud)
但它引入了很多重复。
我可以
delta <- function(a, b, c) {
return((a - c) / ((a + b) * c + a))
}
data <- data %>%
mutate(
delta1 = delta(a1, b1, c1),
delta2 = delta(a2, b2, c2)
)
Run Code Online (Sandbox Code Playgroud)
这使得delta()以后可以轻松地更改功能,但这看起来仍然有很多重复。
我的问题:有没有一种方法可以通过一行 mutate来计算delta1和?delta2
您可能认为重复次数没问题,但我可能需要计算其他几个术语,例如gammai或alphai。重复行感觉不是一个好的解决方案。
我想我可以通过这样做来解决问题
for (i in c(1, 2)) {
data <- data %>%
mutate("delta{i}" := delta(paste0('a', i), paste0('b', i), paste0('c', i)))
}
Run Code Online (Sandbox Code Playgroud)
但我得到了
Error in `mutate()`:
! Problem while computing `delta1 = delta(paste0("a", i), paste0("b", i), paste0("c", i))`.
Caused by error in `a - c`:
! non-numeric argument to binary operator
Run `rlang::last_error()` to see where the error occurred.
Run Code Online (Sandbox Code Playgroud)
循环变异感觉有点不对劲。
我在Mutate multiple / Continuous columns (with dplyr or base R)中看到了解决方案,如何使用 dplyr 改变多个变量?或者使用 dplyr 改变数据框中的多个列,但解决方案的可读性比复制和粘贴行并接受重复项要差得多。
理想情况下,我希望找到一种巧妙的用法across,让我能够编写类似mutate("delta{i}" := delta(a{i}, b{i}, c{i})).
您可以利用glue函数。这可能是最好、最灵活的方式:
library(glue)\ncols <- c("1", "2")\nexprs <- glue("(a{cols} - c{cols}) / ((a{cols} + b{cols}) * c{cols} + a{cols})")\nnames(exprs) <- glue("delta{cols}")\n\ndata |> \n mutate(!!!rlang::parse_exprs(exprs))\n\n# A tibble: 2 \xc3\x97 8\n a1 a2 b1 b2 c1 c2 delta1 delta2\n <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>\n1 32 32 50 12 12 50 0.0197 -0.00806\n2 48 20 55 43 10 42 0.0353 -0.00825\nRun Code Online (Sandbox Code Playgroud)\n如果你想用across,你可以像这样使用一堆:
library(dplyr)\ndata %>% \n mutate((across(starts_with("a"), .names = "delta{sub(\'a\', \'\', .col)}") -\n across(starts_with("c"))) / \n ((across(starts_with("a")) + across(starts_with("b"))) * \n across(starts_with("c")) + across(starts_with("a"))))\n\n# A tibble: 2 \xc3\x97 8\n a1 a2 b1 b2 c1 c2 delta1 delta2\n <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>\n1 32 32 50 12 12 50 0.0197 -0.00806\n2 48 20 55 43 10 42 0.0353 -0.00825\nRun Code Online (Sandbox Code Playgroud)\n但是,您也许应该选择先转向长轴再转向宽轴:
\nlibrary(dplyr)\nlibrary(tidyr)\ndata %>% \n mutate(rown = row_number()) %>% \n pivot_longer(-rown,\n names_to = c(".value", "number"), \n names_pattern = "([a-z])(\\\\d)") %>% \n group_by(rown) %>% \n mutate(delta = (a - c) / ((a + b) * c + a)) %>% \n pivot_wider(names_from = number, \n values_from = a:delta, \n names_sep = "")\n\n# A tibble: 2 \xc3\x97 9\n# Groups: rown [2]\n rown a1 a2 b1 b2 c1 c2 delta1 delta2\n <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>\n1 1 32 32 50 12 12 50 0.0197 -0.00806\n2 2 48 20 55 43 10 42 0.0353 -0.00825\nRun Code Online (Sandbox Code Playgroud)\n