For A New Year, A New Asset Allocation System Just Published in SSRN

[This article was first published on QuantStrat TradeR » R, 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.

Happy New Year!

So, this is something I’ve been working on before its official publication (so this is the first place on the entire internet that you’ll see it outside SSRN, and certainly one of the few places that will extend it), directly in contact with the original paper author, Dr. Wouter Keller, who published the Flexible Asset Allocation algorithm that I improved on earlier. It’s called Elastic Asset Allocation, and seems to be a simpler yet more general algorithm. Here’s the link to the SSRN

Essentially, the algorithm can be explained simply:

Use monthly data.

For a 12 month period, we want the monthly average of the 1, 3, 6, and 12 month cumulative returns (that is, sum all those up, divide by 22), the volatility of the individual monthly returns, and the correlation of the universe of returns to the monthly average of the returns. Then arrange those values in the following expression:

z_i = (r_i ^ wR * (1-c_i) ^ wC / (v_i + error) ^ wV) ^ (wS + error) if r_i > 0, 0 otherwise, where:

r_i are the average returns
c_i are the correlations
v_i are the volatilities

wR, wC, and wV are the respective weights for returns, correlations, and volatilities.

Next, select the top N of P assets to include in the portfolio.

Then, the weights for each security can be expressed as the normalized values of the sum of selected z_i’s.

If a crash protection rule is enabled, compute CP, which is the fraction of the universe of securities (not selected securities, but the entire universe) below zero, divided by the size of the universe, and multiply all weights by 1-CP. Reinvest the remainder in the cash asset (something like VBMFX, VFISX, SHY, etc.). In FAA, I called this the risk-free asset, but in this case, it’s simply the cash asset.

The error term is 1e-6, or some other small value to avoid divide by zero errors.

Finally, wS is an aggression parameter. Setting this value to 0 essentially forces an equal weight portfolio, and infinity will simply select the best asset each month.

Anyhow, let’s look at a prototype of the code (will bug with NA returns, and still doesn’t include excess returns over some treasury security), using the original FAA securities. The weights are wR=1, wC=.5, and wV=0, with wS = 2 for an offensive scheme or wS = 1 for a more defensive scheme. Crash protection is enabled.

require(quantmod)
require(PerformanceAnalytics)

symbols <- c("VTSMX", "FDIVX", "VEIEX", "VBMFX", "VFISX", "VGSIX", "QRAAX")

getSymbols(symbols, from="1990-01-01")
prices <- list()
for(i in 1:length(symbols)) {
  prices[[i]] <- Ad(get(symbols[i]))  
}
prices <- do.call(cbind, prices)
colnames(prices) <- gsub("\.[A-z]*", "", colnames(prices))
ep <- endpoints(prices, "months")
prices <- prices[ep,]
prices <- prices["1997-03::"]

EAA <- function(monthlyPrices, wR=1, wV=0, wC=.5, wS=2, errorJitter=1e-6, 
                cashAsset=NULL, bestN=1+ceiling(sqrt(ncol(monthlyPrices))),
                enableCrashProtection = TRUE, returnWeights=FALSE) {
  returns <- Return.calculate(monthlyPrices)
  returns <- returns[-1,] #return calculation uses one observation
  
  if(is.null(cashAsset)) {
    returns$zeroes <- 0
    cashAsset <- "zeroes"
    warning("No cash security specified. Recommended to use one of: quandClean('CHRIS/CME_US'), SHY, or VFISX. 
            Using vector of zeroes instead.")
  }
  
  cashCol <- grep(cashAsset, colnames(returns))
  
  weights <- list()
  for(i in 1:(nrow(returns)-11)) {
    returnsData <- returns[i:(i+11),] #each chunk will be 12 months of returns data
    #per-month mean of cumulative returns of 1, 3, 6, and 12 month periods
    periodReturn <- ((returnsData[12,] + Return.cumulative(returnsData[10:12,]) + 
      Return.cumulative(returnsData[7:12,]) + Return.cumulative(returnsData)))/22
    vols <- StdDev.annualized(returnsData) 
    mktIndex <- xts(rowMeans(returnsData), order.by=index(returnsData)) #equal weight returns of universe
    cors <- cor(returnsData, mktIndex) #correlations to market index
    
    weightedRets <- periodReturn ^ wR
    weightedCors <- (1 - as.numeric(cors)) ^ wC
    weightedVols <- (vols + errorJitter) ^ wV
    wS <- wS + errorJitter
    
    z <- (weightedRets * weightedCors / weightedVols) ^ wS #compute z_i and zero out negative returns
    z[periodReturn < 0] <- 0
    crashProtection <- sum(z==0)/length(z) #compute crash protection cash cushion
    
    orderedZ <- sort(as.numeric(z), decreasing=TRUE)
    selectedSecurities <- z >= orderedZ[bestN]
    preNormalizedWeights <- z*selectedSecurities #select top N securities, keeping z_i scores
    periodWeights <- preNormalizedWeights/sum(preNormalizedWeights) #normalize
    if (enableCrashProtection) {
      periodWeights <- periodWeights * (1-crashProtection) #CP rule
    }
    weights[[i]] <- periodWeights
  }
  
  weights <- do.call(rbind, weights)
  weights[, cashCol] <- weights[, cashCol] + 1-rowSums(weights) #add to risk-free asset all non-invested weight
  strategyReturns <- Return.rebalancing(R = returns, weights = weights) #compute strategy returns
  if(returnWeights) {
    return(list(weights, strategyReturns))
  } else {
    return(strategyReturns)
  }
}

offensive <- EAA(prices, cashAsset="VBMFX", bestN=3)
defensive <- EAA(prices, cashAsset="VBMFX", bestN=3, wS=1)
compare <- cbind(offensive, defensive)
colnames(compare) <- c("Offensive", "Defensive")
stats <- rbind(Return.annualized(compare)*100, StdDev.annualized(compare)*100, maxDrawdown(compare)*100, SharpeRatio.annualized(compare))
rownames(stats)[3] <- "Worst Drawdown"
charts.PerformanceSummary(compare)

And here are the results:

                                Offensive Defensive
Annualized Return               12.085183 12.178447
Annualized Standard Deviation   11.372610 10.231192
Worst Drawdown                  12.629251 11.021954
Annualized Sharpe Ratio (Rf=0%)  1.062657  1.190325

And the resultant equity curves:

Not a bad algorithm, though the fact that there are only 7 securities here leave it open to some idiosyncratic risk. The low-hanging fruit, of course, is that the correlation uses a single-pass variant, meaning that it is quite possible to select correlated assets that are not correlated to non-selected assets, but are indeed correlated to each other. However, since the actual correlations are used here as opposed to correlation rank, I am thinking that a stepwise correlation selection process would have to be specifically written for this particular algorithm. I’ll no doubt run this by David Varadi and see how to properly set up a stepwise correlation algorithm when working with the interplay of correlations with other values (returns, volatility).

In any case, what I like about this algorithm is that not only is it a security *selection* algorithm, which was what FAA was, but it also includes another aspect, which is the actual weighting aspect, rather than simply leaving all assets at equal weight.

At the moment, this is still in its prototypical phase, and I am aware of the bugs of assets that don’t start at the same time, which will be fixed before I commit this to my IKTrading package. But I wanted to put this out there for those that wished to experiment with it and provide feedback if they came across something they believe is worth sharing.

Thanks for reading.

NOTE: I am a freelance consultant in quantitative analysis on topics related to this blog. If you have contract or full time roles available for proprietary research that could benefit from my skills, please contact me through my LinkedIn here.


To leave a comment for the author, please follow the link and comment on their blog: QuantStrat TradeR » R.

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.

Never miss an update!
Subscribe to R-bloggers to receive
e-mails with the latest R posts.
(You will not see this message again.)

Click here to close (This popup will not appear again)