Увеличьте время выполнения цикла For, заменив его командой lapply

Question

Здесь я работаю над оптимизацией R-кода. Как все мы знаем, наиболее трудоемким является for loop, я пытаюсь заменить его на lapply и экспериментирую, чтобы уменьшить время выполнения.

Как можно видеть на изображении, время, требуемое для выполнения цикла for, занимает 40 мсек, здесь задача состоит в том, как минимизировать время выполнения цикла For Loop с помощью lapply. How to replace this code of for loop with Lapply, чтобы мы могли эффективно оптимизировать скорость обработки кода. Для обозначения времени, необходимого для каждой строки кода, используется библиотека Profvis. Я пытался использовать lapply, я столкнулся с проблемой в реализации

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)
  }

})

Ожидается: Улучшите время выполнения, как показано выше. Для кода Loop время выполнения составляет 40 мсек. Если мы попытаемся использовать lapply, мы можем увеличить время обработки с 40 мсек до 10 мсек или меньше. тогда это.

Answer 1

Не уверен, что вы ожидаете, но что-то вроде этого должно работать:

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
             }))