[R] Speeding up a loop

[Rui Barradas]

Hello,

Maybe it would have been better to start a new thread, if the question 
is different. To show that it's a continuation, the subject line could 
be extended with "part 2" or something like that.

This solution runs in 3.6 hours.


to.keep <- function(x){
     keep <- function(i, env){
         env$ires <- env$ires + 1
         if(env$ires > env$curr.rows){
             env$result <- rbind(env$result, matrix(nrow=increment, 
ncol=nc))
             env$curr.rows <- env$curr.rows + increment
         }
         env$result[env$ires, ] <- x[i, ]
     }

     a1 <- x[, 1]
     a2 <- x[, 2]
     a3 <- x[, 3]
     a4 <- x[, 4]
     nc <- ncol(x)
     increment <- 1000

     e <- new.env()
     e$curr.rows <- increment
     e$result <- matrix(nrow=e$curr.rows, ncol=nc)
     e$ires <- 0

     for(i in seq_len(nrow(x))){
         yes <- x[i, 1] >= a1 | x[i, 2] >= a2 | x[i, 3] <= a3 | x[i, 4] 
 >= a4
         if(all(yes)) keep(i, e)
     }
     e$result[seq_len(e$ires), 1:nc]
}

# Now the timing.

set.seed(3971)
nc <- 26
Enes <- seq(from=1e3, to=1e4, by=1e3)
tm <- numeric(length(Enes))
i <- 0
for(n in Enes){
     i <- i + 1
     N <- nc*n
     m <- matrix(sample(0:9, N, TRUE), ncol=nc)
     tm[i] <- system.time(kp <- to.keep(m))[3]
}

plot(Enes, tm) # quadratic behavior
fit <- lm(tm ~ Enes + I(Enes^2))
(secs <- predict(fit, newdata=data.frame(Enes=503028)))
secs/60/60 # 3.6 hours


Hope this helps,

Rui Barradas

Em 21-07-2012 13:26, wwreith escreveu:
> next for loop question.
>
> I need a loop that removes a row from a matrix if it is worse in positions
> 1,2,3,4 than another row in the matrix. right now my matrix is 503028x26.
>
> Rule to define worse position1 is smaller, position2 is smaller, position3
> is higher, and position4 is smaller
>
> Example:
>
> row1: 1, 10, 3, 3
> row2: 3, 7, 5, 2
>
>
> row2 is not worse than row1 since it is "better" in position 1, eventhough
> it is worse in all other positions.
>
> row3: 2,5,7,1
> row3 however is worse than row2 and should be removed from the matrix.
>
> Any ideas? Should I break this into pieces or do it all at once? Is there
> something faster than a loop? My current loops takes well over 24 hours to
> run.
>
>
> m<-matrix(0,1,24)
> for(i in 1:n)
> {
>   a<-matrix(x[i,1:4],1,4)
> j=1
>        nn<-nrow(m)
>        counter<-0
>        while(j<=nn)
>        {
>          if(a[1]>m[j,1] && a[2]>m[j,2] && a[3]>m[j,4] && a[4]<m[j,4])
>          {
>            m<-m[-j,]
>            nn<-length(m[,1])
>            counter<-1
>          } else j<-j+1
>        }
>        if(counter==1)
>        {
>          b<-cbind(a,x)
>           m<-rbind(m,b)
>        }
>        if(counter==0)
>        {
>          if(a[1]>min(m[,1]) || a[3]>min(m[,3]) || a[4]>min(m[,4]) ||
> a[5]<max(m[,5]))
>          {
>            b<-cbind(a,x)
>             m<-rbind(m,b)
>          }
>       }
> }
>
>
>
> --
> View this message in context: http://r.789695.n4.nabble.com/Speeding-up-a-loop-tp4637201p4637305.html
> Sent from the R help mailing list archive at Nabble.com.
>
> ______________________________________________
> R-help at r-project.org mailing list
> https://stat.ethz.ch/mailman/listinfo/r-help
> PLEASE do read the posting guide http://www.R-project.org/posting-guide.html
> and provide commented, minimal, self-contained, reproducible code.