r - 加快R中的while循环

Question

作为项目的一部分，我制作了一个平滑器来平滑丢失的数据。我利用最后一个数据点的先前斜率来计算新值。计算出每个新点后，我使用这些数据来计算新值(依此类推)。因此，我使用 while 循环来计算每个值(从左到右以及从右到左最终取这两个值的平均值)。这个脚本运行良好!

虽然我希望通过 apply-family 中的函数可以显着加速这一过程，但我仍然想使用这个 while 循环。然而，该脚本确实很慢(大约 2,500,000 个数据点需要 3 天)。您有什么建议(针对当前脚本)供我更改以加快速度吗？

#Loop from: bottom -> top
  number_rows <- nrow(weight_id)
  i <- nrow(weight_id)
   while (i >= 1){
     j = as.integer(weight_id[i,1])
     prev1 <- temp[j+1,]$new_MAP_bottom

     if(j<max(weight_id)){
       previous_slope <- ifelse((temp[j+2,]$duration-temp[j+1,]$duration)>0,prev1-temp[j+2,]$new_MAP_bottom,0)
     }else{
       previous_slope <- 0
     }

     new_MAP <- round(prev1+((previous_slope-(factor*temp[j,]$steps))/(1+factor)), digit=2)
     temp[j,]$new_MAP_bottom <- new_MAP
    i <- i-1
   }

#Loop from: top -> bottom
  weight_factor <- 0
  i <- 1
   while (i <= nrow(weight_id)) {
     j = as.integer(weight_id[i,1])
       prev1 <- temp[j-1,]$new_MAP_top

       if(j>2){
         previous_slope <- ifelse((temp[j-1,]$duration-temp[j-2,]$duration)>0,prev1-temp[j-2,]$new_MAP_top,0)
       }else{
         previous_slope <- 0
       }

       new_MAP <- round(prev1+((previous_slope+(factor*temp[j,]$steps))/(1+factor)), digit=2)
       temp[j,]$new_MAP_top <- new_MAP

       #Take weighted average of two approaches (top -> bottom/bottom -> top)
        if(weight_factor < 1){ weight_factor = temp[j,]$weight-1 }

       weight_top <- weight_factor
       weight_bottom <- temp[j,]$weight-weight_factor

    if(weight_top>weight_bottom){ weight_top<-weight_top-1 }
    if(weight_top<weight_bottom){ weight_bottom<-weight_bottom-1}

   temp[j,]$MAP <- round(((new_MAP*weight_top)+(temp[j,]$new_MAP_bottom*weight_bottom))/(weight_top+weight_bottom),digit=0)
   weight_factor <- weight_factor-1
   i <- i+1
  }

Answer 1

我没有阅读您的所有代码，尤其是没有示例数据，但从文本描述来看，它是唯一的线性近似:请检查内置函数 approx 和 approxfun 已经做了您尝试自己实现的事情，因为通过适当的努力，这些将比您更优化。

par(mfrow=c(2,1))

example <- data.frame(x = 1:14,
                  y = c(3,4,5,NA, NA, NA, 6,7,8.1, 8.2, NA, 8.4, 8.5, NA))

plot(example)

f <- approxfun(example)
plot(example$x, f(example$x))

apply 系列往往会为您提供更短、更简洁的代码，但速度不一定比循环快得多。如果您注重速度，请首先检查其他人是否已经实现了您需要的内容，然后尝试矢量化。

编辑:

以下内容在我的计算机上运行大约一秒钟。如果这所做的事情与您自己的“线性平滑器”足够接近，以便您可以用它替换您的“线性平滑器”，那么速度将提高大约 3 天。

n <- 2500000
example <- data.frame(x = 1:n,
                      y = sample(1:1000, n, replace = TRUE))
example$y[sample(1:n, n/5)] <- NA

print(Sys.time())
f <- approxfun(example)
mean(f(example$x))
print(Sys.time())