如何使用 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 很陌生，所以我非常感謝在這個問題上提供任何幫助。

Answer 1

這是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

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

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

Answer 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

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

基本上，我在所有行中收集所有列的值，將列名稱分成兩部分，計算具有相同字母的列的行總和，然后將其轉換回寬格式。

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))您可能希望用上面的表達式中的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包 （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

Answer 9

這是另一種僅使用管道且不需要創建新對象的 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()管道傳輸到bind_cols() ，它將原始列與新創建的列綁定。 新列是使用purrr::map_dfc()創建的，它采用變量前綴列表 ( .x ) 和轉換函數 ( .f )。 此外，管道數據 ( . ) 被分配為另一個參數 ( .y )。 由於需要逐行操作， rowwise()在前綴的每次迭代中都使用rowwise()和c_across() 。 transmute是為了不復制原始變量。 為了動態創建變量名，在 transmute 中使用了 bang-bang 運算符 ( !! ) 和:= 。

筆記

使用rowSums()代替rowwise()和c_across()會更短，但使用這種方法可以更輕松地實現其他功能。