wake-up-neo.net

Verwendung von map from purrr mit dplyr :: mutate zum Erstellen mehrerer neuer Spalten basierend auf Spaltenpaaren

Ich muss folgendes Problem mit R befolgen. Kurz gesagt, ich möchte mehrere neue Spalten in einem Datenrahmen erstellen, die auf Berechnungen verschiedener Spaltenpaare im Datenrahmen basieren.

Die Daten sehen wie folgt aus:

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

Die Ausgabe sollte wie folgt aussehen:

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

Ich kann dies erreichen, indem ich mit dplyr einige manuelle Arbeit auf folgende Weise erledige:

df %>% rowwise %>% mutate(sum_a = sum(a1, a2),
                          sum_b = sum(b1, b2),
                          sum_c = sum(c1, c2)) %>% 
  as.data.frame()

Was also getan wird, ist: Nimm Spalten mit dem Buchstaben "a", berechne die Summe zeilenweise und erstelle eine neue Spalte mit der Summe sum_ [letter]. Wiederholen Sie dies für Spalten mit verschiedenen Buchstaben.

Dies funktioniert jedoch, wenn ich einen großen Datensatz mit etwa 300 verschiedenen Spaltenpaaren habe, wäre die manuelle Eingabe von Bedeutung, da ich 300 mutate-Aufrufe schreiben müsste.

Ich bin kürzlich auf das R-Paket "purrr" gestoßen und meine Vermutung ist, dass dies mein Problem lösen würde, das zu tun, was ich will, automatisierter.

Insbesondere würde ich denken, dass ich purrr: map2 verwenden kann, an den ich zwei Listen mit Spaltennamen weitergebe. 

  • list1 = alle Spalten mit der Nummer 1
  • list2 = alle Spalten mit der Nummer 2

Dann könnte ich die Summe jedes übereinstimmenden Listeneintrags in der Form berechnen:

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

Ich kann jedoch nicht herausfinden, wie ich dieses Problem am besten mit purrr lösen kann. Ich bin mit Purrr relativ neu, daher würde ich mich über jede Hilfe zu diesem Thema sehr freuen.

10
user30276

Hier ist eine Option mit purrr. Wir erhalten das Präfix unique von names des Datensatzes ('nm1'), verwenden Sie map (von purrr), um die eindeutigen Namen durchzugehen, select die Spalte, die matches der Präfixwert von 'nm1' ist, fügen Sie die Zeilen mit reduce hinzu und binden Sie die Spalten (bind_cols) mit dem ursprünglichen Datensatz 

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
10
akrun

Wenn Sie einen Basis-R-Ansatz in Betracht ziehen möchten, können Sie Folgendes tun:

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

Es teilt die Daten spaltenweise in eine Liste auf, basierend auf dem ersten Buchstaben jedes Spaltennamens (entweder a, b oder c).

Wenn Sie eine große Anzahl von Spalten haben und zwischen allen Zeichen mit Ausnahme der Zahlen am Ende jedes Spaltennamens unterscheiden müssen, können Sie den Ansatz folgendermaßen ändern:

cbind(df, lapply(split.default(df, sub("\\d+$", "", names(df))), rowSums))
4

in der Basis R alle vektorisiert:

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
3

Sehen Sie sich für eine hackhafte aufgeräumte Lösung Folgendes an:

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)

Grundsätzlich sammle ich alle Spaltenpaare mit ihren Werten in allen Zeilen, trenne den Spaltennamen in zwei Teile, berechne die Zeilensummen für Spalten mit demselben Buchstaben und wandle sie zurück in die breite Form.

2
Lorenzo G

Eine andere Lösung, die df durch die Zahlen aufteilt, verwendet Reduce zur Berechnung der 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

Erstellt am 23.08.2014 vom Paket reprex (v0.2.0).

1
Tung

1) dplyr/tidyr In lange Form konvertieren, zusammenfassen und wieder in breite Form konvertieren:

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)

geben:

  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) Basis mit Matrixmultiplikation

nms ist ein Vektor von Spaltennamen ohne die Ziffern und mit sum_ vorangestellt. u ist ein Vektor der eindeutigen Elemente davon. Bilden Sie eine logische Matrix mit outer aus derjenigen, die, wenn sie mit DF multipliziert wird, die Summen ergibt. Die logischen Daten werden dann in 0-1 konvertiert. Binden Sie es schließlich an die Eingabe.

nms <- gsub("(\\D+)\\d", "sum_\\1", names(DF))
u <- unique(nms)
sums <- as.matrix(DF) %*% outer(nms, setNames(u, u), "==")
cbind(DF, sums)

geben:

  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) Basis mit Lappen

Verwenden Sie nms aus (2), um tapply auf jede Zeile anzuwenden:

cbind(DF, t(apply(DF, 1, tapply, nms, sum)))

geben:

  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

Sie können nms durch factor(nms, levels = unique(nms)) im obigen Ausdruck ersetzen, wenn die Namen nicht in aufsteigender Reihenfolge stehen.

1
G. Grothendieck
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
1
Phil

Ein etwas anderer Ansatz unter Verwendung der Basis 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
0
dabsingh