如何使用带有 dplyr::mutate 的 purrr 映射基于列对创建多个新列
How to use map from purrr with dplyr::mutate to create multiple new columns based on column pairs
我必须使用 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 还比较陌生，所以我非常感谢在这个问题上的任何帮助。
如果您想考虑基本的 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))
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) base using matrix multiplication
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))。
这是 purrr 的一个选项。我们得到数据集names的unique前缀（'nm1'），使用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
要获得简洁的解决方案，请查看：
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)
基本上，我收集所有行的所有列对及其值，将列名分成两部分，计算具有相同字母的列的行总和，然后将其转换回宽形式。
另一种解决方案是将 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-04-13。
在 base 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
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
使用基本 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
这是另一种仅使用管道且不需要创建新对象的 tidyverse 方法。
library(tidyverse)
df %>%
bind_cols(
map_dfc(.x = list("a", "b", "c"),
.f = ~ .y %>%
rowwise() %>%
transmute(!!str_c("sum_", .x) := sum(c_across(starts_with(.x)))),
.y = .)
)
#> 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
说明
数据帧通过管道传输到 bind_cols()，它将原始列与新创建的列绑定。新列是使用 purrr::map_dfc() 创建的，它采用变量前缀列表 (.x) 和转换函数 (.f)。此外，管道数据 (.) 被分配为另一个参数 (.y)。由于需要按行操作，因此在前缀的每次迭代中使用 rowwise() 和 c_across()。 transmute 用于使原始变量不重复。为了动态创建变量名，bang-bang 运算符 (!!) 和 := 一起用于 transmute.
备注
使用 rowSums() 代替 rowwise() 和 c_across() 会更短，但使用这种方法可以更轻松地实现其他功能。
我必须使用 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 还比较陌生，所以我非常感谢在这个问题上的任何帮助。
如果您想考虑基本的 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))
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) base using matrix multiplication
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))。
这是 purrr 的一个选项。我们得到数据集names的unique前缀（'nm1'），使用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
要获得简洁的解决方案，请查看：
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)
基本上，我收集所有行的所有列对及其值，将列名分成两部分，计算具有相同字母的列的行总和，然后将其转换回宽形式。
另一种解决方案是将 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-04-13。
在 base 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
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
使用基本 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
这是另一种仅使用管道且不需要创建新对象的 tidyverse 方法。
library(tidyverse)
df %>%
bind_cols(
map_dfc(.x = list("a", "b", "c"),
.f = ~ .y %>%
rowwise() %>%
transmute(!!str_c("sum_", .x) := sum(c_across(starts_with(.x)))),
.y = .)
)
#> 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
说明
数据帧通过管道传输到 bind_cols()，它将原始列与新创建的列绑定。新列是使用 purrr::map_dfc() 创建的，它采用变量前缀列表 (.x) 和转换函数 (.f)。此外，管道数据 (.) 被分配为另一个参数 (.y)。由于需要按行操作，因此在前缀的每次迭代中使用 rowwise() 和 c_across()。 transmute 用于使原始变量不重复。为了动态创建变量名，bang-bang 运算符 (!!) 和 := 一起用于 transmute.
备注
使用 rowSums() 代替 rowwise() 和 c_across() 会更短，但使用这种方法可以更轻松地实现其他功能。