Vermeiden für Schleife in R

Question

Ich hätte gerne einen Tipp zum Schreiben besserer R-Code. Ich habe derzeit eine Schleife in R geschrieben und es leidet unter Leistungsproblemen.

Ich kann mich nicht mit dem Vektorisieren herumschlagen, weil jede Zeile im Ausgabedatenrahmen Abhängigkeiten von früheren Zeilen hat und sie iterativ heruntersickern, also habe ich eine Schleife geschrieben, um die Zeilen in Folge zu lesen/schreiben.

Ein Beispiel für meinen Code:

example <- data.frame(a=c(.5,.1,.5,.25),b=c(1,0,2,0),c=c(1,2,3,4),d=c(4,3,2,1)) 

for (i in 2:nrow(example)) { 
    if (example[i,1]>0) { 
    example[i,2]<-example[i,2]+example[i-1,2]*example[i,1] 
    example[i,3]<-example[i,3]+example[i-1,3]*example[i,1] 
    example[i,4]<-example[i,4]+example[i-1,4]*example[i,1] 

    } 
} 

Um zu sehen, was geschieht:

# before  
    a b c d 
1 0.50 1 1 4 
2 0.10 0 2 3 
3 0.50 2 3 2 
4 0.25 0 4 1 

# after 
    a  b  c  d 
1 0.50 1.0000 1.0000 4.000 
2 0.10 0.1000 2.1000 3.400 
3 0.50 2.0500 4.0500 3.700 
4 0.25 0.5125 5.0125 1.925 

Answer 1

Ich bin nicht sicher, wie durch Zeilenoperationen zu vermeiden, aber hier ist 3, dass die Leistung verbessert berät von ~ X90

1. Verwenden Matrizen statt data.frames für solche Operationen
2. Pre-alocate die Zeilen möchten Sie auf
3. Vectorize Operationen innerhalb der Schleife

Mit anderen Worten arbeiten, versuchen, Ihren Code zu

indx <- which(example[-1, 1] > 0) 
for(i in indx + 1) example[i, -1] <- example[i, -1] + example[i-1, -1] * example[i, 1] 

Umwandlung Beachten Sie auch, dass diese Lösung verallgemeinert für jede Anzahl der Spalten

---

Benchmark

set.seed(123) 
N <- 1e3 
test <- matrix(runif(N * 4), ncol = 4) 
example <- as.data.frame(test) 


OP <- function(x){ 
    for (i in 2:nrow(x)) { 
    if (x[i, 1]>0) { 
     x[i,2]<-x[i,2]+x[i-1,2]*x[i,1] 
     x[i,3]<-x[i,3]+x[i-1,3]*x[i,1] 
     x[i,4]<-x[i,4]+x[i-1,4]*x[i,1] 
    } 
    } 
    x 
} 

David <- function(x){ 
    indx <- which(x[-1, 1] > 0) 
    for(i in indx + 1) x[i, -1] <- x[i, -1] + x[i-1, -1] * x[i, 1] 
    x 
} 

identical(OP(example), as.data.frame(David(test))) 
# [1] TRUE 

library(microbenchmark)  
microbenchmark(OP(example), David(test))  
# Unit: milliseconds 
#  expr  min   lq  mean  median   uq  max neval cld 
# OP(example) 243.913429 246.248061 257.672703 247.104350 256.701590 337.375850 100 b 
# David(test) 3.020688 3.080685 3.336778 3.133483 3.301797 9.240615 100 a