How to optimize this function in R? - r

Question

I have about 977 obs in top500Stocks which contains name of 977 stocks.
head(top500Stocks,10)
ï..Symbol
1 RELIANCE
2 TCS
3 HDFCBANK
4 INFY
5 HINDUNILVR
6 HDFC
7 ICICIBANK
8 KOTAKBANK
9 SBIN
10 BAJFINANCE
and I have Date, OHLC and Adj.Close, Vol and Ret of each stocks from the top500Stocks in stocksRetData
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
Now for a given lookbackPeriod and holdPeriod I am trying to run the below function but it takes about 1 minute. How can I make it faster? Because I have to run for multiple lookbackPeriod and holdPeriod it will take forever to complete.
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))
}
This takes more than a minute to complete.
a <- CalC.MOD_MScore.Ret.High(4,14,fnoStocks = top500Stocks, stocksRetData = stocksRetData, 2000)

Answer 1

First of all, I wouldn't suggest using for-loops in R. I would rewrite your loop with a lapply like
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))
}
Having an lapply makes it easier to throw some parallelization-tools on it.
You can have a look at the package parallel. With this package, you can parallelize and make use of multiple cores on you machine. Therefore, you need to setup a cluster, which produces some overhead, but I think it will pay out in your case. To use it, setup a cluster via cl <- parallel::makeCluster(parallel::detectCores()). The detectCores-method gets the number of available cores on your machine. Then, you can edit the lapply to
WeeklyData <- parallel::parLapply(cl = cl, 1:nrow(fnoStocks), function(i) {
...
})
After all your caluclations finished, call parallel::stopCluster(cl) to stop the cluster.