Wie übersetzt man diese doppelte indizierte for-Schleife in eine effiziente?

Question

Ich bin neu in R und hier. Ich benutze diese Seite sehr oft, aber dieses Mal stecke ich in einem Problem, für das ich keine Lösung finden kann.

Ich habe einen Datenrahmen wie folgt aus:

df <- data.frame(id = c("A","A","B","B","B","C","D","D","D","D"), 
      elapsed = c(10,15,5,7,20,4,3,4,15,16), 
      val = c(5,8,1,2,4,6,7,9,8,3), 
      acum = c(0,0,0,0,0,0,0,0,0,0)) 

Und ich brauche für jede Zeile zu akkumulieren, die Gesamt „val“ aus anderen Reihen mit der gleichen „id“ und ein „abgelaufen“ nicht mehr als 5 Einheiten weniger Strom (es wird in Sekunden gemessen).

Ie .: Ich wähle eine Zeile aus, sage ich, und registriere ihr "val" in acum [i]. Dann schaue ich zurück auf die vorherige Reihe, i-1. Ich überprüfe, dass es dieselbe ID hat wie i an, dass sein "verstrichen" nicht weniger als 5 der der Reihe i ist. Wenn es so ist, summiere ich seinen Wert mit dem acum [i]. Ich wiederhole den Schritt mit allen überlegenen Verzögerungen, und so weiter.

Um das zu tun, rief ich diese Schleife:

for (i in 2:nrow(df)) { 
    for(l in 0:nrow(df)) { 
    if(l<i) { 
     if (df[i,"id"]==df[i-l,"id"]) 
     {if (df[i,"elapsed"]-df[i-l,"elapsed"]<=5) 
     {df$acum[i] <- df$acum[i]+df[i-l,"val"]} 
     } 
    } 
    } 
} 

# id elapsed val acum 
# 1 A  10 5 0 
# 2 A  15 8 13 
# 3 B  5 1 1 
# 4 B  7 2 3 
# 5 B  20 4 4 
# 6 C  4 6 6 
# 7 D  3 7 7 
# 8 D  4 9 16 
# 9 D  15 8 8 
# 10 D  16 3 11 

Das Problem ist, dass, wenn die data.frame größer wird, die Schleife immer mehr Zeit damit verbringt, um diese Aufgabe zu tun (auch mehrere Stunden).

Ich surfte google und navigierte Stackoverflow ein jeder gibt den gleichen Rat: Verwenden Sie die Funktionen anwenden. Aber ich kann mir nicht vorstellen, wie es in diesem Fall geht. Vielleicht mapply, aber da ich neu darin bin bin ich mir nicht sicher wie.

Könnte mir jemand dabei helfen?

Vielen Dank im Voraus, Santiago.-

Answer 1

Betrachten Variablen durch id Gruppe verzögerten erstellen und dann eine ifelse() laufen.

# LAGGED GROUP VARIABLES 
df$lastelapsed <- sapply(1:nrow(df), 
         function(i) sum((df$id[i-1] == df$id[i]) * df$elapsed[i-1])) 
df$lastvalue <- sapply(1:nrow(df), 
         function(i) sum((df$id[i-1] == df$id[i]) * df$val[i-1])) 

# ROW CALCULATION 
df$acumtest <- ifelse((df$elapsed - df$lastelapsed) <= 5, df$val + df$lastvalue, df$val) 

Answer 2

Sie können eine neue Gruppierung Variable auf den elapsed > 5 Kriterien innerhalb der einzelnen ID, basierend erstellen und dann Ihre Lieblings Aggregation Werkzeug

df <- data.frame(id = c("A","A","B","B","B","C","D","D","D","D"), 
       elapsed = c(10,15,5,7,20,4,3,4,15,16), 
       val = c(5,8,1,2,4,6,7,9,8,3), 
       acum = c(0,0,0,0,0,0,0,0,0,0)) 

within(df, { 
    grp <- paste(id, ave(elapsed, id, FUN = function(x) 
    cumsum(c(FALSE, diff(x) > 5)))) 
    acum <- ave(val, grp, FUN = cumsum) 
}) 

# id elapsed val acum grp 
# 1 A  10 5 5 A.0 
# 2 A  15 8 13 A.0 
# 3 B  5 1 1 B.0 
# 4 B  7 2 3 B.0 
# 5 B  20 4 4 B.1 
# 6 C  4 6 6 C.0 
# 7 D  3 7 7 D.0 
# 8 D  4 9 16 D.0 
# 9 D  15 8 8 D.1 
# 10 D  16 3 11 D.1 

einige Benchmarks mit den aktuellen Lösungen verwenden:

library('dplyr') 
library('data.table') 

rawr <- function(df) { 
    df <- within(df, { 
    grp <- paste(id, ave(elapsed, id, FUN = function(x) 
     cumsum(c(FALSE, diff(x) > 5)))) 
    acum <- ave(val, grp, FUN = cumsum) 
    }) 
    df 
} 

## shitty data table version, I'm sure it's wrong 
## rest assured someone will point it out 
rawr_dt <- function(df) { 
    dt <- as.data.table(df) 
    dt[, grp := cumsum(c(FALSE, diff(elapsed) > 5)), by = 'id'][, acum := cumsum(val), c('id', 'grp')] 
    dt[, grp := NULL] 
    dt 
} 

sfucci <- function(df) { 
    for (i in 2:nrow(df)) { 
    for(l in 0:nrow(df)) { 
     if(l<i) { 
     if (df[i,"id"]==df[i-l,"id"]) 
     {if (df[i,"elapsed"]-df[i-l,"elapsed"]<=5) 
     {df$acum[i] <- df$acum[i]+df[i-l,"val"]} 
     } 
     } 
    } 
    } 
    df 
} 

Parfait <- function(df) { 
    df$lastelapsed <- sapply(1:nrow(df), function(i) sum((df$id[i-1] == df$id[i]) * df$elapsed[i-1])) 
    df$lastvalue <- sapply(1:nrow(df), function(i) sum((df$id[i-1] == df$id[i]) * df$val[i-1])) 
    df$acumtest <- ifelse((df$elapsed - df$lastelapsed) <= 5, df$val + df$lastvalue, df$val) 
    df 
} 
alistaire <- function(df) { 
    df %>% 
    group_by(id) %>% 
    mutate(acum = val + (lag(val, default = 0) * 
          ifelse(lag(elapsed, default = 0) >= (elapsed - 5), 1, 0))) 
} 

acc <- rawr(df)$acum 
identical(acc, rawr_dt(df)$acum) 
# [1] TRUE 
# identical(acc, sfucci(df)$acum) 
identical(acc, Parfait(df)$acumtest) 
# [1] TRUE 
identical(acc, alistaire(df)$acum) 
# [1] TRUE 

library('microbenchmark') 
microbenchmark(sfucci(df), rawr(df), rawr_dt(df), Parfait(df), alistaire(df), unit = 'relative') 

# Unit: relative 
#   expr  min  lq  mean median  uq  max neval cld 
#  sfucci(df) 11.596961 9.990698 10.082249 9.952529 10.220162 5.603044 100  e 
#  rawr(df) 1.000000 1.000000 1.000000 1.000000 1.000000 1.000000 100 a  
# rawr_dt(df) 3.771649 3.483610 3.472160 3.436365 3.531379 1.945339 100 d 
# Parfait(df) 3.392426 2.980234 3.008432 2.902410 3.006896 2.361832 100 c 
# alistaire(df) 2.140693 2.042809 2.080444 2.028151 2.029965 2.638486 100 b