Wählen Sie max absoluter Wert für jede numerische Spalte durch eine Gruppierungsspalte in data.table oder dplyr

Question

Hier ist ein Beispiel dafür, was meine data.frame wie folgt aussieht:

opts <- seq(-0.5, 0.5, 0.05) 
df <- data.frame(combo1=sample(opts, 6), 
       combo2=sample(opts, 6), 
       combo3=sample(opts, 6), 
       gene=rep(c("g1", "g2", "g3"), each=2), stringsAsFactors=F) 

df 
    combo1 combo2 combo3 gene 
1 0.40 0.50 -0.10 g1 
2 0.10 -0.20 -0.35 g1 
3 -0.35 -0.35 0.40 g2 
4 0.00 0.10 -0.30 g2 
5 -0.45 -0.10 0.05 g3 
6 -0.40 -0.40 -0.05 g3 

Für jede Combo, möchte ich zu einer Gruppe nach Gen und dann den maximalen absoluten Wert auswählen. Ich kann dies mit dplyr erreichen:

library(dplyr) 
df_final <- data.frame(row.names=unique(df$gene)) 

for (combo in colnames(df)[1:3]) { 

    combo_preds <- df[, c(combo, "gene")] 
    colnames(combo_preds) <- c("pred", "gene") 

    combo_preds %>% 
     group_by(gene) %>% 
     arrange(desc(abs(pred))) %>% 
     slice(1) %>% 
     ungroup() -> 
     combo_preds 

    #add to df_final 
    class(combo_preds) <- "data.frame" 
    df_final[combo_preds$gene, combo] <- combo_preds$pred 
} 
#names rows based on gene 
row.names(df_final) <- unique(df$gene) 

df_final 
    combo1 combo2 combo3 
g1 0.40 0.50 -0.35 
g2 -0.35 -0.35 0.40 
g3 -0.45 -0.40 0.05 

Gibt es eine Möglichkeit, dass ich die oben mit data.table oder einer anderen effizientere Umsetzung erreichen kann? In Wirklichkeit habe ich ~ 1300 dfs mit jeweils ~ 14000 Genen und ~ 650 Combos. Die aktuelle Implementierung dauert 2,6 Minuten pro Tag, also dauert es mehr als 2 Tage.

Answer 1

Sie können es auf jeden Fall tun data.table mit. (Ich habe keine Benchmark für deine Version gemacht).

library(data.table) 
dt <- data.table(df) 
dt[, lapply(.SD, function (col) col[which.max(abs(col))]), by='gene'] 

es im wesentlichen Gruppen Tisch durch Gene, und auf jedes Stück von Tabelle verwendet lapply über jeden Spalt in einer Schleife um den Wert mit dem maximalen Absolutwert zu finden.

Ich denke jedoch, Sie könnten besser Ihre Tabelle zu langen Format umformen, obwohl ich denke, es hängt von Ihren spezifischen Daten ab (Sie müssen versuchen zu sehen).

opts <- seq(-0.5, 0.5, 0.05) 
n.combos <- 600 
n.genes <- 10000 
n.rows.per.gene <- 5 

# columns are called X1 X2 instead of combo1 combo2 but no matter. 
df.wide <- data.frame(replicate(n.combos, sample(opts, n.rows.per.gene, replace=T)), 
         gene=rep(paste0("g", 1:n.genes), each=n.rows.per.gene)) 

Hier df.wide sieht aus wie Ihr Datenrahmen, mit einer Spalte pro Combo und eine Zeile für jede für jedes Gen zu replizieren.

Hier ist das Original data.table Antwort:

# data.table option 
library(data.table) 
dt <- data.table(df.wide) 
system.time({ 
out <- dt[, lapply(.SD, function (col) col[which.max(abs(col))]), by='gene'] 
}) 
# user system elapsed 
# 10.757 0.364 12.612 

Jetzt sind wir zu lange Format neu zu gestalten, die nur eine 'Combo' Spalte und eine Spalte 'Wert':

# reshape to long 
dt.long <- melt(dt, id.vars='gene', variable.name='combo') 
# > head(dt.long) 
# gene combo value 
# 1: g1 X1 0.20 
# 2: g1 X1 0.30 
# 3: g1 X1 0.10 
# 4: g1 X1 0.05 
# 5: g1 X1 0.30 
# 6: g2 X1 0.20 

system.time({out.long <- dt.long[, value[which.max(value)], by='gene,combo']}) 

    user system elapsed 
    8.000 0.472 9.525 

Das gibt Ihnen ein Datenrahmen mit dem Gen, Combo und Wert, der das Maximum absolut war. Sie könnten es zu weit zurückverformen, wenn Sie wollten.

So scheint es nicht viel schneller - ich denke, Sie müssen es auf Ihre Daten versuchen und sehen. Ich nehme an, selbst wenn die zweite Methode schneller ist, müssen Sie immer noch die Zeit berücksichtigen, die benötigt wird, um die Datentabelle zu lang zu machen (was nicht viel aussieht).

Vergleichen mit z.B. dplyr (das ist sehr elegant zu verwenden, aber langsamer)

system.time({ 
out.dplyr <- df.wide %>% group_by(gene) %>% 
    summarise_each(funs(.[which.max(abs(.))])) 
}) 
# user system elapsed 
# 163.106 7.989 189.788 

Answer 2

Ein Verfahren, in Basis R, die funktionieren wird (es gibt viele andere)

# for max absolute value, build a function 
maxAbsObs <- function(x) x[which.max(abs(x))] 


aggregate(df[,grep("combo", names(df))], list(df$gene), maxAbsObs) 

Hier ist ein data.table Verfahren den maximalen Wert jedes Kombinations durch Gen auszuwählen:

library(data.table) 
setDT(df) 
df[, lapply(.SD, maxAbsObs), by="gene"] 

Answer 3

hier ein viel einfacher und schneller dplyr methode:

df %>% group_by(gene) %>% 
    summarise_each(funs(.[which.max(abs(.))])) 

Versuchen es auf reproduzierbare Daten:

set.seed(495) 
opts <- seq(-0.5, 0.5, 0.05) 
df <- data.frame(combo1=sample(opts, 6), 
       combo2=sample(opts, 6), 
       combo3=sample(opts, 6), 
       gene=rep(c("g1", "g2", "g3"), each=2), stringsAsFactors=F) 

df 

combo1 combo2 combo3 gene 
1 -0.15 0.50 -0.25 g1 
2 -0.45 -0.50 0.15 g1 
3 -0.25 0.10 -0.30 g2 
4 0.35 -0.40 -0.15 g2 
5 -0.05 -0.35 -0.40 g3 
6 0.15 -0.05 -0.10 g3 

df %>% group_by(gene) %>% 
    summarise_each(funs(.[which.max(abs(.))])) 

gene combo1 combo2 combo3 
1 g1 -0.45 0.50 -0.25 
2 g2 0.35 -0.40 -0.30 
3 g3 0.15 -0.35 -0.40 

Beachten Sie, dass im obigen Fall gibt es eine Krawatte in den Absolutwert für combo2 und gene=g1. Wenn das wichtig ist, müssen Sie entscheiden, wie Sie Bindungen lösen.

Timings für meine dplyr Verfahren und eine etwas schnellere Version data.table Methode des @ mathematical.coffee (eine viel größere Probe Datenrahmen verwendet wird):

set.seed(495) 
opts <- seq(-0.5, 0.5, 0.05) 
df <- data.frame(combo1=sample(opts, 9e4, replace=TRUE), 
       combo2=sample(opts, 9e4, replace=TRUE), 
       combo3=sample(opts, 9e4, replace=TRUE), 
       gene=rep(c("g1", "g2", "g3"), each=3e4), stringsAsFactors=F) 

microbenchmark::microbenchmark(
    dplyr=setDF(df) %>% group_by(gene) %>% 
    summarise_each(funs(.[which.max(abs(.))])), 
    data.table={setDT(df)[, lapply(.SD, function (col) col[which.max(abs(col))]), by='gene']} 
) 

Unit: milliseconds 
     expr  min  lq  mean median  uq  max neval cld 
    dplyr 10.013623 11.839132 14.156735 12.284574 12.675220 32.35739 100 b 
data.table 4.434841 6.008701 6.947104 6.222775 6.415083 29.52652 100 a 

So sind die data.table läuft Version in etwa der Hälfte der Zeit der dplyr Version.

UPDATE: Um Adresse @ Arun Kommentar, hier ist ein viel größerer Probendatenrahmen mit mehreren Spalten und mehr gene Kategorien.

# Large sample of fake data 
set.seed(194) 
genes=apply(expand.grid(letters,letters), 1, paste, collapse="") 
df = data.frame(replicate(50, rnorm(26*26*1e3)), gene=genes) 
object.size(df) 
# 273 MB 

microbenchmark::microbenchmark(
    dplyr=setDF(df) %>% group_by(gene) %>% 
    summarise_each(funs(.[which.max(abs(.))])), 
    data.table={setDT(df)[, lapply(.SD, function (col) col[which.max(abs(col))]), by='gene']}, 
    times=10 
) 

Unit: milliseconds 
     expr  min  lq  mean median  uq  max neval cld 
    dplyr 1240.1695 1299.0425 1375.8298 1318.5343 1385.5854 1748.8112 10 b 
data.table 464.5597 493.8959 527.7097 519.3607 585.1482 603.3916 10 a 

UPDATE 2: Wie oben, aber mit einer noch größeren Anzahl von Gruppen (26^3 anstelle von 26^2). Wie @Arun diskutiert, steigt der Geschwindigkeitsvorteil mit der größeren Anzahl von Gruppen.

# Large sample of fake data 
    set.seed(194) 
    genes=apply(expand.grid(letters,letters,letters), 1, paste, collapse="") 
    df = data.frame(replicate(50, rnorm(26*26*26*50)), gene=genes) 
    object.size(df) 
    # 356 MB 

    microbenchmark::microbenchmark(
    dplyr=setDF(df) %>% group_by(gene) %>% 
     summarise_each(funs(.[which.max(abs(.))])), 
    data.table={setDT(df)[, lapply(.SD, function (col) col[which.max(abs(col))]), by='gene']}, 
    times=1 
    )  

Unit: seconds 
      expr  min  lq  mean median  uq  max neval 
      dplyr 27.567790 27.567790 27.567790 27.567790 27.567790 27.567790  1   
     data.table 2.765047 2.765047 2.765047 2.765047 2.765047 2.765047  1