# Testing the Hierarchical Risk Parity algorithm

**R – QuantStrat TradeR**, and kindly contributed to R-bloggers]. (You can report issue about the content on this page here)

Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.

This post will be a modified backtest of the Adaptive Asset Allocation backtest from AllocateSmartly, using the Hierarchical Risk Parity algorithm from last post, because Adam Butler was eager to see my results. On a whole, as Adam Butler had told me he had seen, HRP does not generate outperformance when applied to a small, carefully-constructed, diversified-by-selection universe of asset classes, as opposed to a universe of hundreds or even several thousand assets, where its theoretically superior properties result in it being a superior algorithm.

First off, I would like to thank one Matthew Barry, for helping me modify my HRP algorithm so as to not use the global environment for recursion. You can find his github here.

Here is the modified HRP code.

covMat <- read.csv('cov.csv', header = FALSE) corMat <- read.csv('corMat.csv', header = FALSE) clustOrder <- hclust(dist(corMat), method = 'single')$order getIVP <- function(covMat) { invDiag <- 1/diag(as.matrix(covMat)) weights <- invDiag/sum(invDiag) return(weights) } getClusterVar <- function(covMat, cItems) { covMatSlice <- covMat[cItems, cItems] weights <- getIVP(covMatSlice) cVar <- t(weights) %*% as.matrix(covMatSlice) %*% weights return(cVar) } getRecBipart <- function(covMat, sortIx) { w <- rep(1,ncol(covMat)) w <- recurFun(w, covMat, sortIx) return(w) } recurFun <- function(w, covMat, sortIx) { subIdx <- 1:trunc(length(sortIx)/2) cItems0 <- sortIx[subIdx] cItems1 <- sortIx[-subIdx] cVar0 <- getClusterVar(covMat, cItems0) cVar1 <- getClusterVar(covMat, cItems1) alpha <- 1 - cVar0/(cVar0 + cVar1) # scoping mechanics using w as a free parameter w[cItems0] <- w[cItems0] * alpha w[cItems1] <- w[cItems1] * (1-alpha) if(length(cItems0) > 1) { w <- recurFun(w, covMat, cItems0) } if(length(cItems1) > 1) { w <- recurFun(w, covMat, cItems1) } return(w) } out <- getRecBipart(covMat, clustOrder) out

With covMat and corMat being from the last post. In fact, this function can be further modified by encapsulating the clustering order within the getRecBipart function, but in the interest of keeping the code as similar to Marcos Lopez de Prado’s code as I could, I’ll leave this here.

Anyhow, the backtest will follow. One thing I will mention is that I’m using Quandl’s EOD database, as Yahoo has really screwed up their financial database (I.E. some sector SPDRs have broken data, dividends not adjusted, etc.). While this database is a $50/month subscription, I believe free users can access it up to 150 times in 60 days, so that should be enough to run backtests from this blog, so long as you save your downloaded time series for later use by using write.zoo.

This code needs the tseries library for the portfolio.optim function for the minimum variance portfolio (Dr. Kris Boudt has a course on this at datacamp), and the other standard packages.

A helper function for this backtest (and really, any other momentum rotation backtest) is the appendMissingAssets function, which simply adds on assets not selected to the final weighting and re-orders the weights by the original ordering.

require(tseries) require(PerformanceAnalytics) require(quantmod) require(Quandl) Quandl.api_key("YOUR_AUTHENTICATION_HERE") # not displaying my own api key, sorry # function to append missing (I.E. assets not selected) asset names and sort into original order appendMissingAssets <- function(wts, allAssetNames, wtsDate) { absentAssets <- allAssetNames[!allAssetNames %in% names(wts)] absentWts <- rep(0, length(absentAssets)) names(absentWts) <- absentAssets wts <- c(wts, absentWts) wts <- xts(t(wts), order.by=wtsDate) wts <- wts[,allAssetNames] return(wts) }

Next, we make the call to Quandl to get our data.

symbols <- c("SPY", "VGK", "EWJ", "EEM", "VNQ", "RWX", "IEF", "TLT", "DBC", "GLD") rets <- list() for(i in 1:length(symbols)) { # quandl command to download from EOD database. Free users should use write.zoo in this loop. returns <- Return.calculate(Quandl(paste0("EOD/", symbols[i]), start_date="1990-12-31", type = "xts")$Adj_Close) colnames(returns) <- symbols[i] rets[[i]] <- returns } rets <- na.omit(do.call(cbind, rets))

While Josh Ulrich fixed quantmod to actually get Yahoo data after Yahoo broke the API, the problem is that the Yahoo data is now garbage as well, and I’m not sure how much Josh Ulrich can do about that. I really hope some other provider can step up and provide free, usable EOD data so that I don’t have to worry about readers not being able to replicate the backtest, as my policy for this blog is that readers should be able to replicate the backtests so they don’t just nod and take my word for it. If you are or know of such a provider, please leave a comment so that I can let the blog readers know all about you.

Next, we initialize the settings for the backtest.

invVolWts <- list() minVolWts <- list() hrpWts <- list() ep <- endpoints(rets, on = "months") nMonths = 6 # month lookback (6 as per parameters from allocateSmartly) nVol = 20 # day lookback for volatility (20 ibid)

While the AAA backtest actually uses a 126 day lookback instead of a 6 month lookback, as it trades at the end of every month, that’s effectively a 6 month lookback, give or take a few days out of 126, but the code is less complex this way.

Next, we have our actual backtest.

for(i in 1:(length(ep)-nMonths)) { # get returns subset and compute absolute momentum retSubset <- rets[c(ep[i]:ep[(i+nMonths)]),] retSubset <- retSubset[-1,] moms <- Return.cumulative(retSubset) # select top performing assets and subset returns for them highRankAssets <- rank(moms) >= 6 # top 5 assets posReturnAssets <- moms > 0 # positive momentum assets selectedAssets <- highRankAssets & posReturnAssets # intersection of the above selectedSubset <- retSubset[,selectedAssets] # subset returns slice if(sum(selectedAssets)==0) { # if no qualifying assets, zero weight for period wts <- xts(t(rep(0, ncol(retSubset))), order.by=last(index(retSubset))) colnames(wts) <- colnames(retSubset) invVolWts[[i]] <- minVolWts[[i]] <- hrpWts[[i]] <- wts } else if (sum(selectedAssets)==1) { # if one qualifying asset, invest fully into it wts <- xts(t(rep(0, ncol(retSubset))), order.by=last(index(retSubset))) colnames(wts) <- colnames(retSubset) wts[, which(selectedAssets==1)] <- 1 invVolWts[[i]] <- minVolWts[[i]] <- hrpWts[[i]] <- wts } else { # otherwise, use weighting algorithms cors <- cor(selectedSubset) # correlation volSubset <- tail(selectedSubset, nVol) # 20 day volatility vols <- StdDev(volSubset) covs <- t(vols) %*% vols * cors # minimum volatility using portfolio.optim from tseries minVolRets <- t(matrix(rep(1, sum(selectedAssets)))) minVolWt <- portfolio.optim(x=minVolRets, covmat = covs)$pw names(minVolWt) <- colnames(covs) minVolWt <- appendMissingAssets(minVolWt, colnames(retSubset), last(index(retSubset))) minVolWts[[i]] <- minVolWt # inverse volatility weights invVols <- 1/vols invVolWt <- invVols/sum(invVols) invNames <- colnames(invVolWt) invVolWt <- as.numeric(invVolWt) names(invVolWt) <- invNames invVolWt <- appendMissingAssets(invVolWt, colnames(retSubset), last(index(retSubset))) invVolWts[[i]] <- invVolWt # hrp weights clustOrder <- hclust(dist(cors), method = 'single')$order hrpWt <- getRecBipart(covs, clustOrder) names(hrpWt) <- colnames(covs) hrpWt <- appendMissingAssets(hrpWt, colnames(retSubset), last(index(retSubset))) hrpWts[[i]] <- hrpWt } }

In a few sentences, this is what happens:

The algorithm takes a subset of the returns (the past six months at every month), and computes absolute momentum. It then ranks the ten absolute momentum calculations, and selects the intersection of the top 5, and those with a return greater than zero (so, a dual momentum calculation).

If no assets qualify, the algorithm invests in nothing. If there’s only one asset that qualifies, the algorithm invests in that one asset. If there are two or more qualifying assets, the algorithm computes a covariance matrix using 20 day volatility multiplied with a 126 day correlation matrix (that is, sd_20′ %*% sd_20 * (elementwise) cor_126. It then computes normalized inverse volatility weights using the volatility from the past 20 days, a minimum variance portfolio with the portfolio.optim function, and lastly, the hierarchical risk parity weights using the HRP code above from Marcos Lopez de Prado’s paper.

Lastly, the program puts together all of the weights, and adds a cash investment for any period without any investments.

invVolWts <- round(do.call(rbind, invVolWts), 3) # round for readability minVolWts <- round(do.call(rbind, minVolWts), 3) hrpWts <- round(do.call(rbind, hrpWts), 3) # allocate to cash if no allocation made due to all negative momentum assets invVolWts$cash <- 0; invVolWts$cash <- 1-rowSums(invVolWts) hrpWts$cash <- 0; hrpWts$cash <- 1-rowSums(hrpWts) minVolWts$cash <- 0; minVolWts$cash <- 1-rowSums(minVolWts) # cash value will be zero rets$cash <- 0 # compute backtest returns invVolRets <- Return.portfolio(R = rets, weights = invVolWts) minVolRets <- Return.portfolio(R = rets, weights = minVolWts) hrpRets <- Return.portfolio(R = rets, weights = hrpWts)

Here are the results:

compare <- cbind(invVolRets, minVolRets, hrpRets) colnames(compare) <- c("invVol", "minVol", "HRP") charts.PerformanceSummary(compare) rbind(table.AnnualizedReturns(compare), maxDrawdown(compare), CalmarRatio(compare)) invVol minVol HRP Annualized Return 0.0872000 0.0724000 0.0792000 Annualized Std Dev 0.1208000 0.1025000 0.1136000 Annualized Sharpe (Rf=0%) 0.7221000 0.7067000 0.6968000 Worst Drawdown 0.1548801 0.1411368 0.1593287 Calmar Ratio 0.5629882 0.5131956 0.4968234

In short, in the context of a small, carefully-selected and allegedly diversified (I’ll let Adam Butler speak for that one) universe dominated by the process of which assets to invest in as opposed to how much, the theoretical upsides of an algorithm which simultaneously exploits a covariance structure without needing to invert a covariance matrix can be lost.

However, this test (albeit from 2007 onwards, thanks to ETF inception dates combined with lookback burn-in) confirms what Adam Butler himself told me, which is that HRP hasn’t impressed him, and from this backtest, I can see why. However, in the context of dual momentum rank selection, I’m not convinced that any weighting scheme will realize much better performance than any other.

Thanks for reading.

NOTE: I am always interested in networking and hearing about full-time opportunities related to my skill set. My linkedIn profile can be found here.

**leave a comment**for the author, please follow the link and comment on their blog:

**R – QuantStrat TradeR**.

R-bloggers.com offers

**daily e-mail updates**about R news and tutorials about learning R and many other topics. Click here if you're looking to post or find an R/data-science job.

Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.