如何在 R 中优化此功能？

Question

我在top500Stocks 中有大约 977 个 obs，其中包含 977 只股票的名称。

head(top500Stocks,10)
    ï..Symbol
1    RELIANCE
2         TCS
3    HDFCBANK
4        INFY
5  HINDUNILVR
6        HDFC
7   ICICIBANK
8   KOTAKBANK
9        SBIN
10 BAJFINANCE

并且我有 stockRetData 中 top500Stocks 中每只股票的 Date、OHLC 和 Adj.Close、Vol 和 Ret

  head(stocksRetData[[1]],3)
          Date     Open     High      Low    Close Adj.Close    Volume   Ret
    1 20000103 28.18423 29.86935 28.18423 38.94457  29.86935  28802010 0.000
    2 20000104 30.66445 32.26056 29.82188 42.06230  32.26056  61320457 0.080
    3 20000105 30.45677 34.16522 30.45677 43.71014  33.52440 173426953 0.039

现在，对于给定的 lookbackPeriod 和 holdPeriod，我正在尝试运行以下函数，但这大约需要 1 分钟。我怎样才能让它更快？因为我必须运行多个lookbackPeriod 和holdPeriod，所以需要很长时间才能完成。

CalC.MOD_MScore.Ret.High <- function(lookbackPeriod, holdPeriod, fnoStocks, 
                                     stocksRetData, totalTestPeriod) {
  
  #We go through each stock and calculate Modified mscores where we give more importance to recent data
  
  WeeklyData <- list()
  wmean <- function(x, k) mean(seq(k)/k * x)
  
  for (i in 1:nrow(fnoStocks)){
    
    out <- stocksRetData[[i]]
    out <- tail(out,totalTestPeriod)
    
    if (nrow(out)==totalTestPeriod){
      
      tempDF <- transform(out, wtMean = rollapply(Ret, lookbackPeriod, wmean, 
                                                  k = lookbackPeriod, align = "right", 
                                                  fill = NA))
      
      tempDF <- transform(tempDF, ExitVal = rollapply(lead(High, holdPeriod), 
                                                      holdPeriod, max, 
                                                      align = "right", 
                                                        fill = NA))
      
      tempDF$NWeekRet <- (tempDF$ExitVal - tempDF$Adj.Close ) / tempDF$Adj.Close
      
      tempDF <- tempDF[!is.na(tempDF$wtMean),]
      tempDF <- tempDF[!is.na(tempDF$ExitVal),]
      tempDF$StockName = fnoStocks[i,1]
      tempDF$WeekNum = c((lookbackPeriod):(nrow(tempDF)+lookbackPeriod-1))
      
      WeeklyData[[i]] <- data.frame(
        StockName = tempDF$StockName,
        WeekNum = tempDF$WeekNum,
        M_Score = tempDF$wtMean,
        NWeekRet = tempDF$NWeekRet,
        stringsAsFactors =  FALSE
      )
      
    }
  }# i ends here
  
  return(bind_rows(WeeklyData))
}

这需要一分钟以上才能完成。

 a <- CalC.MOD_MScore.Ret.High(4,14,fnoStocks = top500Stocks, stocksRetData = stocksRetData, 2000)

Answer 1

首先，我不建议在R 中使用for-loops。我会用lapply 重写你的循环

CalC.MOD_MScore.Ret.High <- function(lookbackPeriod, holdPeriod, fnoStocks, 
                                     stocksRetData, totalTestPeriod) {
  
  #We go through each stock and calculate Modified mscores where we give more importance to recent data
  
  wmean <- function(x, k) mean(seq(k)/k * x)
  
  WeeklyData <- lapply(1:nrow(fnoStocks), function(i) {
    out <- stocksRetData[[i]]
    out <- tail(out,totalTestPeriod)
    if(nrow(out)!=totalTestPeriod) return(NULL)
    
    tempDF <- transform(out, wtMean = rollapply(Ret, lookbackPeriod, wmean, 
                                                k = lookbackPeriod, align = "right", 
                                                fill = NA))
    
    tempDF <- transform(tempDF, ExitVal = rollapply(lead(High, holdPeriod), 
                                                    holdPeriod, max, 
                                                    align = "right", 
                                                    fill = NA))
    
    tempDF$NWeekRet <- (tempDF$ExitVal - tempDF$Adj.Close ) / tempDF$Adj.Close
    
    tempDF <- tempDF[!is.na(tempDF$wtMean),]
    tempDF <- tempDF[!is.na(tempDF$ExitVal),]
    tempDF$StockName = fnoStocks[i,1]
    tempDF$WeekNum = c((lookbackPeriod):(nrow(tempDF)+lookbackPeriod-1))
    
    data.frame(
      StockName = tempDF$StockName,
      WeekNum = tempDF$WeekNum,
      M_Score = tempDF$wtMean,
      NWeekRet = tempDF$NWeekRet,
      stringsAsFactors =  FALSE
    )
  })
  
  return(bind_rows(WeeklyData))
}

拥有lapply 可以更轻松地在其上添加一些并行化工具。 你可以看看包parallel。使用这个包，您可以在您的机器上并行化和使用多个内核。因此，您需要设置一个集群，这会产生一些开销，但我认为它会在您的情况下得到回报。要使用它，请通过cl <- parallel::makeCluster(parallel::detectCores()) 设置集群。 detectCores-方法获取您机器上可用内核的数量。然后，您可以将lapply 编辑为

WeeklyData <- parallel::parLapply(cl = cl, 1:nrow(fnoStocks), function(i) {
  ...
})

所有计算完成后，调用parallel::stopCluster(cl) 停止集群。