如何使用 purrr 中的 map 和 dplyr::mutate 根据列对创建多个新列答案

【问题标题】：How to use map from purrr with dplyr::mutate to create multiple new columns based on column pairs如何使用 purrr 中的 map 和 dplyr::mutate 根据列对创建多个新列
【发布时间】：2018-09-23 19:03:40
【问题描述】：

我必须使用 R 来解决问题。简而言之，我想根据数据框中不同列对的计算在数据框中创建多个新列。

数据如下：

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_[letter] 的新列。对具有不同字母的列重复此操作。

但是，如果我有一个包含 300 个不同列对的大型数据集，那么手动输入会很重要，因为我必须编写 300 个 mutate 调用。

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

特别是，我认为能够使用 purrr:map2 向其中传递两个列名列表。

list1 = 编号为 1 的所有列
list2 = 编号为 2 的所有列

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

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

但是，我无法弄清楚如何使用 purrr 最好地解决这个问题。我对使用 purrr 比较陌生，所以我非常感谢您在这个问题上的任何帮助。

【问题讨论】：

当你有 54 列之后，列名会变成 ...aa1, aa2, ab1, ab2 等吗？
我看到答案已被编辑以反映上述查询。由于缺乏一个整洁的解决方案......我认为可能会有类似group_by 的转置，例如slice_by???
非常感谢大家。我使用了 group_by 的经典 tidyverse 方法，在途中收集、传播和总结（非常类似于下面“Lorenzo G”和“G. Grothendieck”在答案 #1 中提出的方法）。我从未与 slice_by 合作过，但我想这也会很好地工作。我想使用映射的方法来使代码更短、更标准化，而“akrun”提出的解决方案非常适合这种需求。再次感谢您！

标签： r purrr dplyr

【解决方案1】：

这是purrr 的一个选项。我们得到数据集（'nm1'）的names的unique前缀，使用map（来自purrr）循环遍历唯一的名称，select是matches前缀值的列'nm1'，使用reduce 添加行并将列（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

【讨论】：

这就是我正在寻找的解决方案，谢谢！它完成了我在途中使用收集、传播和总结所做的事情，但代码行数更少。我会说这是一个非常好的解决方案，可以自动化我打算做的事情。我知道 purrr 在这个意义上是强大的。我绝对需要阅读有关使用 purrr 的内容，以便将其纳入我的日常工作流程中。
names(df) %>% sub("\\d+$", "", .) %>% 根据@docendodiscimus 解决方案的许多列
@StephenHenderson 是的，这是一个好方法。在这里，我想如果字母只在第一个位置，我们可以使用substr

【解决方案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

【讨论】：

【解决方案3】：

如果您想考虑使用基本 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))

【讨论】：

【解决方案4】：

在基础 R 中，全部矢量化：

nms <- names(df)
df[paste0("sum_",unique(gsub("[1-9]","",nms)))] <-
  df[endsWith(nms,"1")] + df[endsWith(nms,"2")]

#   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

【讨论】：

如果你想让它也可以扩展到任意函数 - Map(`+`, df[endsWith(names(df),"1")], df[endsWith(names(df),"2")])

【解决方案5】：

对于一个 hackish 整洁的解决方案，请查看：

library(tidyr)
library(dplyr)

df %>% 
   rownames_to_column(var = 'row') %>% 
   gather(a1:c2, key = 'key', value = 'value') %>% 
   extract(key, into = c('col.base', 'col.index'), regex = '([a-zA-Z]+)([0-9]+)') %>% 
   group_by(row, col.base) %>% 
   summarize(.sum = sum(value)) %>%
   spread(col.base, .sum) %>% 
   bind_cols(df, .) %>% 
   select(-row)

基本上，我收集所有行中的所有列对及其值，将列名分成两部分，计算具有相同字母的列的行总和，然后将其转换回宽格式。

【讨论】：

类似于我也会做的事情。一个不错的 tidyverse 方法。谢谢！

【解决方案6】：

另一种将df 拆分为数字的解决方案，而不是使用Reduce 来计算sum

library(tidyverse)

df %>% 
  split.default(., substr(names(.), 2, 3)) %>% 
  Reduce('+', .) %>% 
  set_names(paste0("sum_", substr(names(.), 1, 1))) %>% 
  cbind(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

由reprex package (v0.2.0) 于 2018 年 4 月 13 日创建。

【讨论】：

【解决方案7】：

1) dplyr/tidyr 转换为长格式，汇总并转换回宽格式：

library(dplyr)
library(tidyr)

DF %>%
  mutate(Row = 1:n()) %>%
  gather(colname, value, -Row) %>%
  group_by(g = gsub("\\d", "", colname), Row) %>%
  summarize(sum = sum(value)) %>%
  ungroup %>%
  mutate(g = paste("sum", g, sep = "_")) %>%
  spread(g, sum) %>%
  arrange(Row) %>%
  cbind(DF, .) %>%
  select(-Row)

给予：

  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  4  7 13 12  6 18    16    13    31
4  5  8 14 13  7 19    18    15    33

2) 使用矩阵乘法的基数

nms 是不带数字的列名向量，以sum_ 开头。 u 是它的唯一元素的向量。使用outer 形成一个逻辑矩阵，乘以DF 得到总和——完成后逻辑转换为0-1。最后将其绑定到输入。

nms <- gsub("(\\D+)\\d", "sum_\\1", names(DF))
u <- unique(nms)
sums <- as.matrix(DF) %*% outer(nms, setNames(u, u), "==")
cbind(DF, sums)

给予：

  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  4  7 13 12  6 18    16    13    31
4  5  8 14 13  7 19    18    15    33

3) 带有 tapply 的底座

使用 (2) 中的 nms 将 tapply 应用于每一行：

cbind(DF, t(apply(DF, 1, tapply, nms, 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  4  7 13 12  6 18    16    13    31
4  5  8 14 13  7 19    18    15    33

如果名称不按升序排列，您可能希望在上述表达式中将 nms 替换为 factor(nms, levels = unique(nms))。

【讨论】：

【解决方案8】：

使用 base R 的稍微不同的方法：

cbind(df, lapply(unique(gsub("\\d+","", colnames(df))), function(li) {
   set_names(data.frame(V = apply(df[grep(li, colnames(df), val = T)], FUN = sum, MARGIN = 1)), paste0("sum_", li))
}))
#  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

【讨论】：