（tidyverse 方法）跨多个列计算行和，其中要包含的列信息来自不同的数据框答案

【问题标题】：(tidyverse approach) calculating rowsum across several columns where info on columns to include comes from a different data frame（tidyverse 方法）跨多个列计算行和，其中要包含的列信息来自不同的数据框
【发布时间】：2020-12-02 12:40:29
【问题描述】：

假设以下数据：

dat <- data.frame(x1 = c(1, 2, 3, 4, 5),
                  x2 = c(2, 3, 4, 5, 6),
                  x3 = c(3, 4, 5, 6, 7),
                  x4 = c(7, 2, 3, 4, 5),
                  x5 = c(7, 2, 1, 4, 5))

进一步假设如下查找表：

lookup_positions <- data.frame(v1 = c(1,3,5),
                               v2 = c(1,2,5),
                               v3 = c(1,3,4),
                               v4 = c(2,3,5))

现在，我要做的是：对于dat 中的每一行，我想遍历lookup_positions 中指定的所有组合并计算dat 列的行总和 lookup_positions中指定的位置。

所以对于dat中的所有行我想计算dat[,c(1,3,5)]的行总和，然后我想计算dat[, c(1,2,5)]的行总和等等。所以我基本上计算了4行总和。

我知道如何使用循环在 base R 中执行此操作，我现在也知道如何以 tidyverse 方法执行 one 行总和，但不知道如何执行它适用于lookup_positions 中提到的所有版本，带有没有循环的 tidyverse。

所以预期的结果是：

  x1 x2 x3 x4 x5 rowsum1 rowsum2 rowsum3 rowsum4
1  1  2  3  7  7      11      10      11      12
2  2  3  4  2  2       8       7       8       9
3  3  4  5  3  1       9       8      11      10
4  4  5  6  4  4      14      13      14      15
5  5  6  7  5  5      17      16      17      18

这是我在 tidyverse 中的一个 lookup_positions 得到的。但我被困在如何为所有查找位置概括这一点。

dat %>%
  mutate(rowsum1 = apply(across(everything()), 1, function(x) sum(x[as.numeric(lookup_positions[1,])])))

我知道对于我的 4 个查找位置，我可以简单地复制粘贴并完成它，但我的现实生活数据有几百个查找位置组合。

【问题讨论】：

检查 ?rowSums() 来自 tidyverse 包。
tidyverse中没有rowSums函数。
另外，问题不在于如何计算行总和，我的问题是在我的几个lookup_positions中推广我的方法。

标签： r tidyverse

【解决方案1】：

dplyr 和 purrr 选项可以是：

map2(.x = asplit(lookup_positions, 2),
     .y = 1:ncol(lookup_positions),
     ~ dat %>%
      mutate(!!paste0("rowsums", .y) := rowSums(select(., .x)))) %>%
 reduce(full_join)

  x1 x2 x3 x4 x5 rowsums1 rowsums2 rowsums3 rowsums4
1  1  2  3  7  7       11       10       11       12
2  2  3  4  2  2        8        7        8        9
3  3  4  5  3  1        9        8       11       10
4  4  5  6  4  4       14       13       14       15
5  5  6  7  5  5       17       16       17       18

【讨论】：

有趣。我不能说我完全理解这里发生的事情，但我一定会尝试的。谢谢。

【解决方案2】：

这是您可能感兴趣的另一个tidyverse 解决方案

library(dplyr)
library(purrr)
library(stringr)

dat %>% 
  mutate(map_dfc(
    lookup_positions %>% rename_with(~str_replace(., "v", "rowsum")), 
    ~rowSums(.y[, .x]), 
    across(everything())
  ))

输出

  x1 x2 x3 x4 x5 rowsum1 rowsum2 rowsum3 rowsum4
1  1  2  3  7  7      11      10      11      12
2  2  3  4  2  2       8       7       8       9
3  3  4  5  3  1       9       8      11      10
4  4  5  6  4  4      14      13      14      15
5  5  6  7  5  5      17      16      17      18

【讨论】：

【解决方案3】：

我在 github 上有一个包 {dplyover} 可以帮助完成此类任务。在这种情况下，我们可以使用over 来循环lookup_positions，将每一列用作across 调用的输入，然后我们将其通过管道传递给rowSums。我们可以在 .names 参数中添加 rowsum 即时创建漂亮的名称，然后在 .names_fn 参数中使用 gsub 删除 v。

library(dplyr)
library(dplyover) # https://github.com/TimTeaFan/dplyover/

lookup_positions <- data.frame(v1 = c(1,3,5),
                               v2 = c(1,2,5),
                               v3 = c(1,3,4),
                               v4 = c(2,3,5))

dat %>% 
  mutate(over(lookup_positions,
              ~ across(all_of(.x)) %>% rowSums,
              .names = "rowsum{x}",
              .names_fn = ~ gsub("v(\\d$)", "\\1", .x)))

#>   x1 x2 x3 x4 x5 rowsum1 rowsum2 rowsum3 rowsum4
#> 1  1  2  3  7  7      11      10      11      12
#> 2  2  3  4  2  2       8       7       8       9
#> 3  3  4  5  3  1       9       8      11      10
#> 4  4  5  6  4  4      14      13      14      15
#> 5  5  6  7  5  5      17      16      17      18

^{由reprex package (v2.0.1) 于 2021-08-20 创建}

或者，如果我们可以给lookup_positions data.frame 提供漂亮的列名，然后在purrr::mapdfc 中以类似的方式使用它。

library(purrr)

lookup_positions <- tibble(`rowsum1` = c(1,3,5),
                           `rowsum2` = c(1,2,5),
                           `rowsum3` = c(1,3,4),
                           `rowsum4` = c(2,3,5))

dat %>% 
  mutate(map_dfc(lookup_positions,
                 ~ across(all_of(.x)) %>% rowSums))

#>   x1 x2 x3 x4 x5 rowsum1 rowsum2 rowsum3 rowsum4
#> 1  1  2  3  7  7      11      10      11      12
#> 2  2  3  4  2  2       8       7       8       9
#> 3  3  4  5  3  1       9       8      11      10
#> 4  4  5  6  4  4      14      13      14      15
#> 5  5  6  7  5  5      17      16      17      18

^{由reprex package (v2.0.1) 于 2021-08-20 创建}

【讨论】：

【解决方案4】：

为了记录（我不知道 tidyverse :-) 使用 data.table 和 base R.

library(data.table)

setDT(dat)

rowsumX <- gsub("v", "rowsum", names(lookup_positions))
dat[, by=seq_len(nrow(dat)), 
  (rowsumX) := lapply(lookup_positions, function(x) sum(unlist(.SD)[x]))
]

输出

   x1 x2 x3 x4 x5 rowsum1 rowsum2 rowsum3 rowsum4
1:  1  2  3  7  7      11      10      11      12
2:  2  3  4  2  2       8       7       8       9
3:  3  4  5  3  1       9       8      11      10
4:  4  5  6  4  4      14      13      14      15
5:  5  6  7  5  5      17      16      17      18

【讨论】：