如何使用purrr包中的map和dplyr包中的mutate函数，基于列对创建多个新列？

Question

我需要用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还比较新，所以我真的很感激任何关于这个问题的帮助。

- user30276

---

在您拥有54列后，列名是否会变成aa1、aa2、ab1、ab2等？ - Stephen Henderson

我看到答案已经被编辑以反映上述查询。关于缺乏整洁的解决方案...我认为可能会有类似于group_by的转置，例如slice_by??? - Stephen Henderson

非常感谢大家。我使用了经典的tidyverse方法，包括group_by、gather、spread和summing up（与下面“Lorenzo G”和“G. Grothendieck”在答案#1中提出的方法非常相似）。我从未使用过slice_by，但我想那也可以很好地工作。 我想使用映射方法使代码更短、更标准化，而“akrun”提出的解决方案完全符合这个需求。再次感谢！ - user30276

Answer 1

这里是使用purrr的一种选项。我们获取数据集（'nm1'）的名称的唯一前缀，使用purrr中的map循环遍历唯一名称，select匹配“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

- akrun

---

这就是我一直在寻找的解决方案，谢谢！它实现了我本来会使用 gather、spread 和汇总的方式，但代码行数更少。我认为这是自动化我想要做的事情的非常好的解决方案。我知道 purrr 在这方面非常强大。我肯定需要阅读有关使用 purrr 的资料，以便将其纳入我的日常工作流程中。 - user30276

names(df) %>% sub("\\d+$", "", .) %>% 根据 @docendodiscimus 的解决方案，适用于许多列。 - Stephen Henderson

@StephenHenderson 是的，那是一个好方法。在这里，我认为如果字母仅位于第一个位置，我们可以使用 substr。 - akrun

我们可以使用这种方法进行减法吗？如果可以，我们如何指定从哪里减去什么？ - thentangler

@thentangler 试试使用 reduce(-)（用反引号括起来）。它应该按照我们在 nm1 中使用的顺序。如果你想要不同的顺序，那么就必须重新排列 'nm1'。 - akrun

substr函数仅提取a，b和c。如果我想要计算a2-a1，我应该重新排列数据框以使其按照a2 b2 c2 a1 b1 c1的顺序吗？ - thentangler

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

- Phil

Answer 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))

- talat

Answer 4

这里是另一种整洁的途径，只使用管道符，而不需要创建新对象。

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使得原始变量不会被复制。为了动态创建变量名，使用双感叹号运算符(!!)以及:=在transmute内部使用。

注意

使用rowSums()代替rowwise()和c_across()会更短，但是其他函数可以更容易地使用此方法实现。

- fjesser

---

我们可以使用这种方法进行减法吗？如果可以，我们如何指定从哪里减去什么？ - thentangler

Answer 5

在基本的 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

- moodymudskipper

---

如果您想将其扩展到任意函数 - Map(\+`, df[endsWith(names(df),"1")], df[endsWith(names(df),"2")])` - thelatemail

Answer 6

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进行基础操作

使用第二部分中的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

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

- G. Grothendieck

Answer 7

以下是一个简单的解决方法:

如果你想要一个快速的解决方案，请看这里：

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)

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

- Lorenzo G

---

和我想做的很相似。一个漂亮的 tidyverse 方法。谢谢！ - user30276

Answer 8

另一种解决方案是通过数字拆分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日。

- Tung

Answer 9

使用基本的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

- dabsingh

Answer 10

有两种方法在现有答案中尚未涵盖：

1. dplyr::across 2. 使用'dplyover'包，使用dplyover::across()或dplyover::over()

免责声明：我是'dplyover'的维护者，该软件包不在CRAN上。

让我们从一个非常高效的仅使用'dplyr'的解决方案开始，使用across()函数： 在across内部，我们可以使用cur_column()函数获取当前列的名称。基于此，我们可以使用gsub()函数将列名从a1更改为a2，然后使用get()函数获取该列的值。

我们可以在.names参数中使用相同的原则。在这里，我们使用{.x}来访问当前列的名称。我们可以使用其他函数表达式，例如将它们用花括号括起来的gsub()函数。

library(dplyr) 

df %>% 
  mutate(across(ends_with("1"),
                ~ .x + get(gsub("(.*)1$",    # <- search for pattern ending with 1 
                                "\\12",      # <- replace with everything \\1 and add 2
                                cur_column() # <- apply this to current column name
                                )
                           ),
                .names = "sum_{gsub('$1', '', {.col} )}"
                )
         )
#>   a1 b1 c1 a2 b2 c2 sum_a1 sum_b1 sum_c1
#> 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

上述方法在处理分组数据时具有计算效率，但它相当冗长且难以理解。

'dplyover'包提供了两种适用于此任务的替代方案。第一种是across2()。我们可以通过迭代列对来创建新的列。这里使用ends_with("1")和ends_with("2")。最后，across2()通过其.names参数轻松命名新的列。我们可以使用{pre}来找到当前列对的公共前缀。

library(dplyover)

# using across2()
df %>% 
  mutate(across2(ends_with("1"),
                 ends_with("2"),
                 ~ .x + .y,
                 .names = "sum_{pre}")
         )
#>   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

across2() 的一个缺点是，它假设要添加的列按正确的顺序排列。如果有很多列，很难检查是否满足这个条件。为了使方法更加程序上安全，我们可以使用 over()。在这里，我们遍历一个包含列名前缀的字符串。我们使用 cut_names() 生成这个字符串，它会在特定模式（这里是数字 "\d"）之前截断列名，从而得到一个向量 c("a", "b", "c")。然后，我们可以将变量名构造为字符串，并用 .() 包裹起来，其中 {.x} 代表当前的字符串。同样，.names 可以方便地给输出列命名。

# using over()

df %>% 
  mutate(over(cut_names("\\d"), # <- this yields c("a", "b", "c")
              ~ .("{.x}1") + .("{.x}2"),
              .names = "sum_{x}")
         )
#>   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

OP的数据：

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))

^{2023-07-15创建，使用reprex v2.0.2}

- TimTeaFan