如何使用map from purrr与dplyr::mutate基于列对创建多个新列

Question

简而言之，我想根据数据框中不同列对的计算，在数据框中创建多个新列。

数据如下：

df <- data.frame(a1 = c(1:5), 
                 b1 = c(4:8), 
                 c1 = c(10:14), 
                 a2 = c(9:13), 
                 b2 = c(3:7), 
                 c2 = c(15:19))
df
a1 b1 c1 a2 b2 c2
1  4 10  9  3 15
2  5 11 10  4 16
3  6 12 11  5 17
4  7 13 12  6 18
5  8 14 13  7 19

输出应该如下所示：

a1 b1 c1 a2 b2 c2 sum_a sum_b sum_c
1  4 10  9  3 15    10     7    25
2  5 11 10  4 16    12     9    27
4  7 13 12  6 18    16    13    31
5  8 14 13  7 19    18    15    33

我可以使用dplyr通过以下方式进行一些手动工作来实现这一点：

df %>% rowwise %>% mutate(sum_a = sum(a1, a2),
                          sum_b = sum(b1, b2),
                          sum_c = sum(c1, c2)) %>% 
  as.data.frame()

所以我们要做的是：取包含字母“a”的列，逐行计算总和，并创建一个总和为sum_[字母]的新列。对不同字母的列重复。

这是有效的，但是，如果我有一个包含300个不同列对的大型数据集，则手动输入将非常重要，因为我必须编写300个突变调用。

我最近偶然发现了R包“purrr”，我的猜测是这将解决我以更自动化的方式做我想做的事情的问题。

特别是，我认为能够使用purrr： map2，我将两个列名列表传递给它。

• list1=其中包含数字1的所有列
• list2=其中包含数字2的所有列

然后，我可以计算每个匹配列表条目的总和，形式为:

map2(list1, list2, ~mutate(sum))

然而，我无法找出如何使用purrr最好地解决这个问题。我对使用purrr相当陌生，因此我非常感谢在这个问题上的任何帮助。

Answer 1

如果您想考虑使用base R方法，您可以这样做:

cbind(df, lapply(split.default(df, substr(names(df), 0,1)), rowSums))
#  a1 b1 c1 a2 b2 c2  a  b  c
#1  1  4 10  9  3 15 10  7 25
#2  2  5 11 10  4 16 12  9 27
#3  3  6 12 11  5 17 14 11 29
#4  4  7 13 12  6 18 16 13 31
#5  5  8 14 13  7 19 18 15 33

它根据每个列名称（a、b 或 c）的第一个字母按列将数据拆分为一个列表。

如果您有大量列并且需要区分除每个列名末尾的数字之外的所有字符，您可以将方法修改为：

cbind(df, lapply(split.default(df, sub("\\d+$", "", names(df))), rowSums))

Answer 2

df %>% 
  mutate(sum_a = pmap_dbl(select(., starts_with("a")), sum), 
         sum_b = pmap_dbl(select(., starts_with("b")), sum),
         sum_c = pmap_dbl(select(., starts_with("c")), sum))

  a1 b1 c1 a2 b2 c2 sum_a sum_b sum_c
1  1  4 10  9  3 15    10     7    25
2  2  5 11 10  4 16    12     9    27
3  3  6 12 11  5 17    14    11    29
4  4  7 13 12  6 18    16    13    31
5  5  8 14 13  7 19    18    15    33

编辑：

如果有许多列，并且您希望以编程方式应用它:

row_sums <- function(x) {
  transmute(df, !! paste0("sum_", quo_name(x)) := pmap_dbl(select(df, starts_with(x)), sum))
}

newdf <- map_dfc(letters[1:3], row_sums)
newdf

  sum_a sum_b sum_c
1    10     7    25
2    12     9    27
3    14    11    29
4    16    13    31
5    18    15    33

如果需要，您可以使用以下命令固定原始变量：

bind_cols(df, dfnew)

  a1 b1 c1 a2 b2 c2 sum_a sum_b sum_c
1  1  4 10  9  3 15    10     7    25
2  2  5 11 10  4 16    12     9    27
3  3  6 12 11  5 17    14    11    29
4  4  7 13 12  6 18    16    13    31
5  5  8 14 13  7 19    18    15    33

Answer 3

这里是< code>purrr的一个选项。我们获取数据集(' nm1 ')的< code>names的< code>unique前缀，使用< code>map(来自< code>purrr)遍历唯一名称，< code >选择与前缀值' nm1 '匹配的列，使用< code>reduce添加行，并将列(< code>bind_cols)与原始数据集绑定

library(tidyverse)
nm1 <- names(df) %>% 
          substr(1, 1) %>%
          unique 
nm1 %>% 
     map(~ df %>% 
            select(matches(.x)) %>%
            reduce(`+`)) %>%
            set_names(paste0("sum_", nm1)) %>%
     bind_cols(df, .)
#    a1 b1 c1 a2 b2 c2 sum_a sum_b sum_c
#1  1  4 10  9  3 15    10     7    25
#2  2  5 11 10  4 16    12     9    27
#3  3  6 12 11  5 17    14    11    29
#4  4  7 13 12  6 18    16    13    31
#5  5  8 14 13  7 19    18    15    33