Dual Momentum Strategy Backtest in R

A lot has been written about Antonacci's Dual Momentum Investing book in which he described his Global Equities Momentum (GEM) strategy along with more general concepts concerning various types of funds, modern portfolio theory, behavioral finance, risk management and other areas. It's definitely worth reading even if you are not that interested in momentum investing alone.

The GEM strategy itself is relatively simple yet it seems quite robust. On Gary's website you can find its monthly returns dating back to early 70s and - as he states - there are now several hundred years of out-of-sample performance supporting momentum (hence its nickname "premier anomaly" used throughout the book).

The GEM strategy is described in chapter 8. The FAQ on Gary's website can help to fill the gaps. You can find there for example a list of recommended ETFs to use in the model. He recommends IVV or VOO for S&P 500 Index (SPY has slight return disadvantage). VEU or VXUS for non-U.S. stocks; BIL or SHV for U.S. Treasury Bills and BND or AGG for Aggregate Bond Index. Of course these are not the only options, merely recommendations.

Strategy Implementation in R

Note that in line 11 contents of a file called allocation_returns.csv are stored in ALLOC variable. It's a file containing GEM allocation and returns as stated on Gary's website. It is used for comparison with the results of this implementation. You can download the file here. If you want to run the code don't forget to set correctly the working directory in the first line and the file path in line 11.

setwd('C:/Zorro/Scripts/DualMomentum')  
library('quantmod')  
library('PerformanceAnalytics')

# Get Yahoo history data
symbols <- c('AGG', 'BIL', 'IVV', 'VEU')  
getSymbols(symbols, src='yahoo', from = '1990-01-01')

# Load GEM allocation data
# src: http://www.optimalmomentum.com/gem_allocation.html
ALLOC <- read.zoo('./data/allocation_returns.csv',  
                  format='%Y-%m-%d', sep=',', header=T)
ALLOC <- xts(ALLOC)  
ALLOC[ALLOC$GEMASSET == '',]$GEMASSET <- NA  
ALLOC <- ALLOC[rowSums(is.na(ALLOC)) != ncol(ALLOC), ]

# Choose ETFs to use
US <- to.period(IVV[,6], period='months')[,4] # IVV or VOO or VTI  
WORLD <- to.period(VEU[,6], period='months')[,4] # VEU or VXUS or VEA  
BONDS <- to.period(AGG[,6], period='months')[,4] # AGG or BND or TLT  
TBILLS <- to.period(BIL[,6], period='months')[,4] # BIL or SHV (if IR near 0)

# Subset data based on shortest history available 
date.first <- max(first(index(US)), first(index(WORLD)),  
                  first(index(BONDS)), first(index(TBILLS)))
date.last <- min(last(index(US)), last(index(WORLD)),  
                 last(index(BONDS)), last(index(TBILLS)))
US <- US[index(US) >= date.first & index(US) <= date.last, ]  
WORLD <- WORLD[index(WORLD) >= date.first & index(WORLD) <= date.last, ]  
BONDS <- BONDS[index(BONDS) >= date.first & index(BONDS) <= date.last, ]  
TBILLS <- TBILLS[index(TBILLS) >= date.first & index(TBILLS) <= date.last, ]

# Check whether the number of rows is equal for each ETF
stopifnot((nrow(US) == nrow(WORLD)) &&  
            (nrow(BONDS) == nrow(TBILLS)) && 
            (nrow(US) == nrow(BONDS)))

# Create empty Time-Series object with two columns
returns <- xts(order.by=index(US)[14:length(index(US))])  
returns <- cbind(returns, rep(NA, length(index(returns))))  
returns <- cbind(returns, rep(NA, length(index(returns))))  
colnames(returns) <- c('asset', 'return')

# Perform the back test
asset.current <- ''  
for(i in 13:nrow(US)) {  
  dt = index(US)[i] # date

  # Compute 12 month returns
  US.RET <- (as.double(US[i]) - as.double(US[i-12])) / 
    as.double(US[i-12])
  WORLD.RET <- (as.double(WORLD[i]) - as.double(WORLD[i-12])) / 
    as.double(WORLD[i-12])
  TBILLS.RET <- (as.double(TBILLS[i]) - as.double(TBILLS[i-12])) / 
    as.double(TBILLS[i-12])

  # Compute return for current month
  if(asset.current == 'SP500') {
    SP500.RET <- (as.double(US[i]) - as.double(US[i-1])) / 
      as.double(US[i-1]) 
    returns[dt,] <- c('SP500', SP500.RET)

  } else if(asset.current == 'AggregateBonds') {
    BONDS.RET <- (as.double(BONDS[i]) - as.double(BONDS[i-1])) / 
      as.double(BONDS[i-1]) 
    returns[dt,] <- c('AggregateBonds', BONDS.RET)

  } else if(asset.current == 'ACWIexUS') {
    ACWI.RET <- (as.double(WORLD[i]) - as.double(WORLD[i-1])) / 
      as.double(WORLD[i-1]) 
    returns[dt,] <- c('ACWIexUS', ACWI.RET)
  }

  # Decide instrument to hold
  if(US.RET - TBILLS.RET >= 0) {
    if(US.RET > WORLD.RET)
      asset.current <- 'SP500'
    else if(WORLD.RET - TBILLS.RET >= 0)
      asset.current <- 'ACWIexUS'
    else
      asset.current <- 'AggregateBonds'
  } else {
    asset.current <- 'AggregateBonds'
  }
} # END FOR

# Add GEM allocation return and asset columns
index(returns) <- as.yearmon(index(returns))  
index(ALLOC) <- as.yearmon(index(ALLOC))  
returns <- cbind(returns, ALLOC[,c(5,4)])  
returns <- returns[!is.na(returns$asset),]  
colnames(returns) <- c('asset', 'return', 'gem.asset', 'gem.return')  
returns$gem.return <- as.double(returns$gem.return) / 100

# Plot cumulative sum for both computed returns and GEM returns
ret.xts <- xts(x=as.double(returns[,2]), order.by=index(returns))  
gem.xts <- xts(x=as.double(returns[,4]), order.by=index(returns))  
plot.xts(cumsum(ret.xts), main='Return Comparison')  
lines(cumsum(gem.xts), col='darkred')  
legend('topleft', c('Return', 'GEM'), col=c('black', 'darkred'), lty=1, cex=.65)

# Print some statistics
print(SharpeRatio.annualized(ret.xts))  
print(SharpeRatio.annualized(gem.xts))  
print(Return.annualized(ret.xts, scale=12))  
print(Return.annualized(gem.xts, scale=12))  

Results

With the above selected ETFs the backtest starts in June 2008 and ends in January 2017. The allocations differ during some month to those published on Gary's website but this might be due to slightly different implementation or due to different ETFs used. The Annualized Return and Annualized Sharpe Ratio are close enough: the implementation gives 8.8% AR which is the same as the results published by Gary Antonacci. The Sharpe is 0.76 compared with 0.77. The plotted cumulative returns look like this:

Dual momentum backtest results

Schizo Frenetik

Read more posts by this author.

Subscribe to StatsMage — Quant Ideas Worth Sharing

Get the latest posts delivered right to your inbox.

or subscribe via RSS with Feedly!