CODEWITHSUNDEEP
rfor-loopoptimizationparallel-processinglapply
Harvey
Harvey

Reputation: 255

Improve Excecution Time of For Loop by Replacing it with lapply command

Here I am working on optimization of R-code , As we all know Most time consuming is for loop , I am trying to replace it with lapply and experiment to reduce the Execution time.

Time Line for every processing syntax: Profvis As one can see in the image the time required to excute the for loop is taking 40 Msec , here the task is to how one can minimize the execution time for For Loop here By using lapply . How to replace this code of for loop with Lapply so that we can optimize the processing speed of code afficiently. To dentify the time required for every line of code Library Profvis is used. I have tried using the lapply , I am facing issue in implementation 

library(profvis)
profvis({
rm(list = ls())
# Creating Dummy data 
row_id <- 100
No_of_level <- 4
spliz <- paste("c(","TRUE,",paste(rep("FALSE",(row_id-1)),collapse=","),")")
d <- as.data.frame(matrix(,nrow = row_id*No_of_level ,ncol=2))
names(d) <- c("Tag","y_pred")
d$Tag <-  cumsum(rep(eval(parse(text=spliz)),4))
d$y_pred <- sample(3:4, row_id*No_of_level, rep = TRUE)
d$y_pred <- paste("L",d$y_pred,sep="")
#### ------------------------------------

# How to replce Below For Loop codes to lapply and get the result in the variable.     
    v <- data.frame();i=0
    for (i in (1:max(d$Tag))){
      #i=4
      s <- filter(d , Tag == i)
s$y_pred <- as.character(s$y_pred)
      temp = 0
      for(i in 1:nrow(s))
      s$R2[i] <- ifelse(s$y_pred[i] == "L3", temp <- temp + 1, 0)
      s$seq <- seq_along(1:nrow(s))
      s$Aoc <- (1-(s$R2/s$seq))*100
      s$Aoc1 <- (s$R2/s$seq)
      v <- rbind(v,s)
  }

})

Expected : Improve the execution time as of now for above For Loop code , execution time is 40 msec , if we try with lapply may be we can bring Processing time from 40 msec to 10 msec or less then that.

Upvotes: 2

Views: 100

Answers (1)

zx8754
zx8754

Reputation: 56249

Not sure what your expected output is, but something like this should work:

v <- do.call(rbind, 
             lapply(split(d, d$Tag), function(s){
               res <- s
               res$R2 <- ifelse(as.character(res$y_pred) == "L3", 
                                cumsum(as.character(res$y_pred) == "L3")), 0)
               res$seq <- seq_along(1:nrow(res))
               re$Aoc <- (1-(res$R2/res$seq))*100
               res$Aoc1 <- (res$R2/res$seq)
               #return
               res
             }))

Upvotes: 2

Related Questions