首页 文章

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

提问于
浏览 次
9

我必须使用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 dplyr purrr mutate

7 回答

  • 3
    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
    回复于
  • 4

    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) base with tapply

    使用 nms （2）将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 .

    回复于
  • 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-04-13 .

    回复于
  • 1

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

    对于一个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)

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

    回复于
  • 2

    这是 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
    回复于
  • 1

    在基数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
    回复于

相关问题