2016-05-19 2 views
0

Ich habe eine Tabelle mit> 100 Spalten, und viele Spalten haben die gleichen Namen. Ich möchte diese Spalten mit den gleichen Namen zusammenführen und die Werte in diesen Spalten addieren. Ich denke, dass die bedingte Ausführung, if(), es tun sollte, aber ich bleibe dabei, die Bedingung für identische Spaltennamen zu schreiben? Und was wird die Funktion sein, die Spalten zusammenzuführen und zu summieren? verschmelzen()? oder rowsum()?R: Zusammenführen von Spalten und die Werte, wenn sie den gleichen Spaltennamen haben

aa <- read.table()

if (colnames(aa) ==) merge/rowsum()

Danke.

Dies ist ein Beispiel, was es sieht aus wie jetzt:

B C U B C 
1 1 1 1 1 
2 2 2 2 2 
3 3 3 3 3 
4 4 4 4 4 

Und das ist, was ich hoffe, zu bekommen: die Werte Reduzierung der Anzahl der Spalten und summieren beim Einarbeiten.

B C U 
2 2 1 
4 4 2 
6 6 3 
8 8 4 

Antwort

3

Lösung 1

Mit split(), lapply(), rowSums() und do.call()/cbind():

do.call(cbind,lapply(split(seq_len(ncol(df)),names(df)),function(x) rowSums(df[x]))); 
##  B C U 
## [1,] 2 2 1 
## [2,] 4 4 2 
## [3,] 6 6 3 
## [4,] 8 8 4 

Lösung 2

Ersetzen der rowSums() Anruf mit Reduce()/`+`():

do.call(cbind,lapply(split(seq_len(ncol(df)),names(df)),function(x) Reduce(`+`,df[x]))); 
##  B C U 
## [1,] 2 2 1 
## [2,] 4 4 2 
## [3,] 6 6 3 
## [4,] 8 8 4 

Lösung 3

den Indexvektor middleman Austauschen mit den data.frame Aufspalten (als unclassed Liste) direkt:

do.call(cbind,lapply(split(as.list(df),names(df)),function(x) Reduce(`+`,x))); 
##  B C U 
## [1,] 2 2 1 
## [2,] 4 4 2 
## [3,] 6 6 3 
## [4,] 8 8 4 

Benchmarking

library(microbenchmark); 

bgoldst1 <- function(df) do.call(cbind,lapply(split(seq_len(ncol(df)),names(df)),function(x) rowSums(df[x]))); 
bgoldst2 <- function(df) do.call(cbind,lapply(split(seq_len(ncol(df)),names(df)),function(x) Reduce(`+`,df[x]))); 
bgoldst3 <- function(df) do.call(cbind,lapply(split(as.list(df),names(df)),function(x) Reduce(`+`,x))); 
sotos <- function(df) sapply(unique(names(df)), function(i)rowSums(df[names(df) == i])); 

df <- data.frame(B=c(1L,2L,3L,4L),C=c(1L,2L,3L,4L),U=c(1L,2L,3L,4L),B=c(1L,2L,3L,4L),C=c(1L,2L,3L,4L),check.names=F); 

ex <- bgoldst1(df); 
all.equal(ex,sotos(df)[,colnames(ex)]); 
## [1] TRUE 
all.equal(ex,bgoldst2(df)); 
## [1] TRUE 
all.equal(ex,bgoldst3(df)); 
## [1] TRUE 

microbenchmark(bgoldst1(df),bgoldst2(df),bgoldst3(df),sotos(df)); 
## Unit: microseconds 
##   expr  min  lq  mean median  uq  max neval 
## bgoldst1(df) 245.473 258.3030 278.9499 272.4155 286.742 641.052 100 
## bgoldst2(df) 156.949 166.3580 184.2206 171.7030 181.539 1042.618 100 
## bgoldst3(df) 82.110 92.5875 100.9138 97.2915 107.128 170.207 100 
##  sotos(df) 200.997 211.9030 226.7977 223.6630 235.210 328.010 100 

set.seed(1L); 
NR <- 1e3L; NC <- 1e3L; 
df <- setNames(nm=LETTERS[sample(seq_along(LETTERS),NC,T)],data.frame(replicate(NC,sample(seq_len(NR*3L),NR,T)))); 

ex <- bgoldst1(df); 
all.equal(ex,sotos(df)[,colnames(ex)]); 
## [1] TRUE 
all.equal(ex,bgoldst2(df)); 
## [1] TRUE 
all.equal(ex,bgoldst3(df)); 
## [1] TRUE 

microbenchmark(bgoldst1(df),bgoldst2(df),bgoldst3(df),sotos(df)); 
## Unit: milliseconds 
##   expr  min  lq  mean median  uq  max neval 
## bgoldst1(df) 11.070218 11.586182 12.745706 12.870209 13.234997 16.15929 100 
## bgoldst2(df) 4.534402 4.680446 6.161428 6.097900 6.425697 44.83254 100 
## bgoldst3(df) 3.430203 3.555505 5.355128 4.919931 5.219930 41.79279 100 
##  sotos(df) 19.953848 21.419628 22.713282 21.829533 22.280279 60.86525 100 
+0

hah ... Großartig. Danke dafür :) – Sotos

+0

Kein Problem :) – bgoldst

+1

Danke, bgoldst! Lösung 1 und 2 gaben diesen Fehler: Fehler in df [x]: Objekt des Typs 'closure' ist keine Teilmenge. Aber Lösung 3 hat funktioniert. Gut genug für mich! –

2

Eine Möglichkeit, es zu tun,

sapply(unique(names(df)), function(i)rowSums(df[names(df) == i])) 

#  B C U 
#[1,] 2 2 1 
#[2,] 4 4 2 
#[3,] 6 6 3 
#[4,] 8 8 4 
1

Hier ist eine weitere Option mit melt/dcast von data.table. Wir konvertieren den 'data.frame' in 'data.table' (setDT(df1)), erstellen eine Zeilennummerspalte ('rn'), melt von 'wide' zu 'long' Format und dann dcast es zu 'wide' durch Angabe der fun.aggregate als sum.

library(data.table) 
setDT(df1)[, rn := 1:.N] 
dcast(melt(df1, id.var= "rn"), rn ~variable, value.var="value", sum)[, rn:= NULL][] 
# B C U 
#1: 2 2 1 
#2: 4 4 2 
#3: 6 6 3 
#4: 8 8 4