# An Update on Flexible Asset Allocation

**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.

A few weeks back, after seeing my replication, one of the original authors of the Flexible Asset Allocation paper got in touch with me to tell me to make a slight adjustment to the code, in that rather than remove any negative-momentum securities before performing any ranking, to perform all ranking without taking absolute momentum into account, and only removing negative absolute momentum securities at the very end, after allocating weights.

Here’s the new code:

FAA <- function(prices, monthLookback = 4, weightMom = 1, weightVol = .5, weightCor = .5, riskFreeName = NULL, bestN = 3, stepCorRank = FALSE, stepStartMethod = c("best", "default"), geometric = TRUE, ...) { stepStartMethod <- stepStartMethod[1] if(is.null(riskFreeName)) { prices$zeroes <- 0 riskFreeName <- "zeroes" warning("No risk-free security specified. Recommended to use one of: quandClean('CHRIS/CME_US'), SHY, or VFISX. Using vector of zeroes instead.") } returns <- Return.calculate(prices) monthlyEps <- endpoints(prices, on = "months") riskFreeCol <- grep(riskFreeName, colnames(prices)) tmp <- list() dates <- list() for(i in 2:(length(monthlyEps) - monthLookback)) { #subset data priceData <- prices[monthlyEps[i]:monthlyEps[i+monthLookback],] returnsData <- returns[monthlyEps[i]:monthlyEps[i+monthLookback],] #perform computations momentum <- data.frame(t(t(priceData[nrow(priceData),])/t(priceData[1,]) - 1)) momentum <- momentum[,!is.na(momentum)] #momentum[is.na(momentum)] <- -1 #set any NA momentum to negative 1 to keep R from crashing priceData <- priceData[,names(momentum)] returnsData <- returnsData[,names(momentum)] momRank <- rank(momentum) vols <- data.frame(StdDev(returnsData)) volRank <- rank(-vols) cors <- cor(returnsData, use = "complete.obs") if (stepCorRank) { if(stepStartMethod=="best") { compositeMomVolRanks <- weightMom*momRank + weightVol*volRank maxRank <- compositeMomVolRanks[compositeMomVolRanks==max(compositeMomVolRanks)] corRank <- stepwiseCorRank(corMatrix=cors, startNames = names(maxRank), bestHighestRank = TRUE, ...) } else { corRank <- stepwiseCorRank(corMatrix=cors, bestHighestRank=TRUE, ...) } } else { corRank <- rank(-rowSums(cors)) } totalRank <- rank(weightMom*momRank + weightVol*volRank + weightCor*corRank) upper <- length(names(returnsData)) lower <- max(upper-bestN+1, 1) topNvals <- sort(totalRank, partial=seq(from=upper, to=lower))[c language="(upper:lower)"][/c] #compute weights longs <- totalRank %in% topNvals #invest in ranks length - bestN or higher (in R, rank 1 is lowest) longs[momentum < 0] <- 0 #in previous algorithm, removed momentums < 0, this time, we zero them out at the end. longs <- longs/sum(longs) #equal weight all candidates longs[longs > 1/bestN] <- 1/bestN #in the event that we have fewer than top N invested into, lower weights to 1/top N names(longs) <- names(totalRank) #append removed names (those with momentum < 0) removedZeroes <- rep(0, ncol(returns)-length(longs)) names(removedZeroes) <- names(returns)[!names(returns) %in% names(longs)] longs <- c(longs, removedZeroes) #reorder to be in the same column order as original returns/prices longs <- data.frame(t(longs)) longs <- longs[, names(returns)] #append lists tmp[[i]] <- longs dates[[i]] <- index(returnsData)[nrow(returnsData)] } weights <- do.call(rbind, tmp) dates <- do.call(c, dates) weights <- xts(weights, order.by=as.Date(dates)) weights[, riskFreeCol] <- weights[, riskFreeCol] + 1-rowSums(weights) strategyReturns <- Return.rebalancing(R = returns, weights = weights, geometric = geometric) colnames(strategyReturns) <- paste(monthLookback, weightMom, weightVol, weightCor, sep="_") return(strategyReturns) }

And here are the new results, both with the original configuration, and using the stepwise correlation ranking algorithm introduced by David Varadi:

mutualFunds <- c("VTSMX", #Vanguard Total Stock Market Index "FDIVX", #Fidelity Diversified International Fund "VEIEX", #Vanguard Emerging Markets Stock Index Fund "VFISX", #Vanguard Short-Term Treasury Fund "VBMFX", #Vanguard Total Bond Market Index Fund "QRAAX", #Oppenheimer Commodity Strategy Total Return "VGSIX" #Vanguard REIT Index Fund ) #mid 1997 to end of 2012 getSymbols(mutualFunds, from="1997-06-30", to="2014-10-30") tmp <- list() for(fund in mutualFunds) { tmp[[fund]] <- Ad(get(fund)) } #always use a list hwne intending to cbind/rbind large quantities of objects adPrices <- do.call(cbind, args = tmp) colnames(adPrices) <- gsub(".Adjusted", "", colnames(adPrices)) original <- FAA(adPrices, riskFreeName="VFISX") swc <- FAA(adPrices, riskFreeName="VFISX", stepCorRank = TRUE) originalOld <- FAAreturns(adPrices, riskFreeName="VFISX") swcOld <- FAAreturns(adPrices, riskFreeName="VFISX", stepCorRank=TRUE) all4 <- cbind(original, swc, originalOld, swcOld) names(all4) <- c("original", "swc", "origOld", "swcOld") charts.PerformanceSummary(all4) > rbind(Return.annualized(all4)*100, + maxDrawdown(all4)*100, + SharpeRatio.annualized(all4)) original swc origOld swcOld Annualized Return 12.795205 14.135997 13.221775 14.037137 Worst Drawdown 11.361801 11.361801 13.082294 13.082294 Annualized Sharpe Ratio (Rf=0%) 1.455302 1.472924 1.377914 1.390025

And the resulting equity curve comparison

Overall, it seems filtering on absolute momentum after applying all weightings using only relative momentum to rank actually improves downside risk profiles ever so slightly compared to removing negative momentum securities ahead of time. In any case, FAAreturns will be the function that removes negative momentum securities ahead of time, and FAA will be the ones that removes them after all else is said and done.

I’ll return to the standard volatility trading agenda soon.

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.

**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.