【问题标题】:For Loop in R (Looking for an alternative)R中的For循环(寻找替代方案)
【发布时间】:2018-06-22 14:32:58
【问题描述】:

以下代码运行了一个循环,但问题在于速度;这需要几个小时才能完成,我正在寻找替代方案,这样我就不必等待这么长时间了。

基本上代码做了以下计算:

1.-It calculates the mean of the values of the 60 days.
2.-It gets the standard deviation of the values of the 60 days.
3.-It gets the Max of the values of the 60 days.
4.-It gets the Min of the values of the 60 days.
5.-Then with the previous calculations the code "smooths" the peaks up and down.
6.-Then the code simply get the means from 60, 30, 15 and 7 Days.

所以这些代码的目的是使用已经提到的方法去除数据的峰值。

代码如下:

options(stringsAsFactors=F)

DAT <- data.frame(ITEM = "x", CLIENT = as.numeric(1:100000), matrix(sample(1:1000, 60, replace=T), ncol=60, nrow=100000, dimnames=list(NULL,paste0('DAY_',1:60))))

DATT <- DAT

nRow <- nrow(DAT)
TMP  <- NULL
for(iROW in 1:nRow){#iROW <- 1
 print(c(iROW,nRow))

  Demand <- NULL
  for(iCOL in 3:ncol(DAT)){#iCOL <- 1
      Demand  <- c(Demand,DAT[iROW,iCOL])

  }

  ww <- which(!is.na(Demand))

  if(length(ww) > 0){
    Average <- round(mean(Demand[ww]),digits=4)
    DesvEst  <- round(sd(Demand,na.rm=T),digits=4)
    Max      <- round(Average + (1 * DesvEst),digits=4)
    Min      <- round(max(Average - (1 * DesvEst), 0),digits=4)
    Demand  <- round(ifelse(is.na(Demand), Demand, ifelse(Demand > Max, Max, ifelse(Demand < Min, Min, Demand))))
    Prom60   <- round(mean(Demand[ww]),digits=4)
    Prom30   <- round(mean(Demand[intersect(ww,(length(Demand) - 29):length(Demand))]),digits=4)
    Prom15   <- round(mean(Demand[intersect(ww,(length(Demand) - 14):length(Demand))]),digits=4)
    Prom07   <- round(mean(Demand[intersect(ww,(length(Demand) - 6):length(Demand))]),digits=4)

  }else{
    Average <- DesvEst <- Max <- Min <- Prom60 <- Prom30 <- Prom15 <- Prom07 <- NA

  }

  DAT[iROW,3:ncol(DAT)] <- Demand
  TMP <- rbind(TMP, cbind(DAT[iROW,], Average, DesvEst, Max, Min, Prom60, Prom30, Prom15, Prom07))
}
DAT <- TMP

【问题讨论】:

  • 看看tidyverse 包。 dplyr 是一个高效而简单的 data.frame 操作包。此外,data.table 包(您可能错误地标记了它)实现了data.table 类,其方法比基础 r 更有效。
  • 你能提供你的数据集的输出吗?前几行会很好。
  • 我认为您可以使用类似 Demand &lt;- as.numeric(DAT[iROW,3:ncol(DAT)]) 的方式摆脱内部 for 循环

标签: r loops data.table smoothing


【解决方案1】:

如果有人通过分析器运行您的代码(行数较少),则会发现主要问题最终是rbind,其次是@Riverarodrigoa 提到的c

我们可以通过创建合适大小的数字矩阵并使用它们来专注于这两个。只有最终创建了最终的data.frame

options(stringsAsFactors=F)
N <- 1000
set.seed(42)
DAT <- data.frame(ITEM = "x", 
                  CLIENT = as.numeric(1:N), 
                  matrix(sample(1:1000, 60, replace=T), ncol=60, nrow=N, dimnames=list(NULL,paste0('DAY_',1:60))))

nRow <- nrow(DAT)
TMP  <- matrix(0, ncol = 8, nrow = N,  
               dimnames = list(NULL, c("Average", "DesvEst", "Max", "Min", "Prom60", "Prom30", "Prom15", "Prom07")))
DemandMat <- as.matrix(DAT[,3:ncol(DAT)])

for(iROW in 1:nRow){
  Demand <- DemandMat[iROW, ]

  ww <- which(!is.na(Demand))

  if(length(ww) > 0){
    Average <- round(mean(Demand[ww]),digits=4)
    DesvEst  <- round(sd(Demand,na.rm=T),digits=4)
    Max      <- round(Average + (1 * DesvEst),digits=4)
    Min      <- round(max(Average - (1 * DesvEst), 0),digits=4)
    Demand  <- round(ifelse(is.na(Demand), Demand, ifelse(Demand > Max, Max, ifelse(Demand < Min, Min, Demand))))
    Prom60   <- round(mean(Demand[ww]),digits=4)
    Prom30   <- round(mean(Demand[intersect(ww,(length(Demand) - 29):length(Demand))]),digits=4)
    Prom15   <- round(mean(Demand[intersect(ww,(length(Demand) - 14):length(Demand))]),digits=4)
    Prom07   <- round(mean(Demand[intersect(ww,(length(Demand) - 6):length(Demand))]),digits=4)

  }else{
    Average <- DesvEst <- Max <- Min <- Prom60 <- Prom30 <- Prom15 <- Prom07 <- NA

  }
  DemandMat[iROW, ] <- Demand 
  TMP[iROW, ] <- c(Average, DesvEst, Max, Min, Prom60, Prom30, Prom15, Prom07)
}
DAT <- cbind(DAT[,1:2], DemandMat, TMP)

对于 1000 行,这大约需要 0.2 秒而不是超过 4 秒。对于 10.000 行,我得到 2 秒而不是 120 秒。

显然,这不是真正漂亮的代码。使用tidyversedata.table 可以做得更好。我只是发现值得注意的是for 循环在 R 中不一定很慢。但是动态增长的数据结构是。

【讨论】:

    猜你喜欢
    • 1970-01-01
    • 2015-07-30
    • 1970-01-01
    • 1970-01-01
    • 2021-05-11
    • 2020-11-14
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    相关资源
    最近更新 更多