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

所以正在做的是：带字母＆＃34; a＆＃34;在其中，逐行计算总和，并创建一个名为sum_ [letter]的总和的新列。对具有不同字母的列重复。

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

我最近偶然发现了R包＆＃34; purrr＆＃34;而我的猜测是，这将解决我以更自动化的方式做我想做的事情。

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

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

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

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

但是，我无法弄清楚如何使用purrr最好地解决这个问题。我很擅长使用purrr，所以我非常感谢你对这个问题的任何帮助。

Answer 1

以下是purrr的一个选项。我们得到数据集unique的{{1}}前缀（'nm1'），使用names（来自map）循环显示唯一名称{{1} } purrr前缀值为'nm1'的列，使用select添加行并将列（matches）与原始数据集绑定

reduce

Answer 2

如果你想考虑基础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 3

基础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

Answer 4

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

Answer 5

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

$('.ms-metadata').first().text('something else');

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

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为基础

使用（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

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

Answer 7

将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。

Answer 8

使用基数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

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

8 个答案: