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系列往往会为您提供更简洁，更简洁的代码，但不一定要比循环更快。如果你速度快，首先检查，如果其他人已经实现了，你需要什么，然后尝试矢量化。

编辑：

以下在我的计算机上运行一秒钟。如果这样做的事情足够接近你自己的线性平滑＆＃34;所以你可以用这个替换你的，这是一个大约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())

在R中循环加速

1 个答案:

编辑：