Momentum Strategy – Boosting Returns – VFINX / VFITX

In this post we will look at a strategy that is 100% invested in the S&P500 and during adverse conditions, is 100% invested in an intermediate term treasury bond. The two funds used for the strategy:

Vanguard 500 Index Fund Investor Class(VFINX)
Vanguard Intermediate-Term Treasury Fund Investor Shares(VFITX)

The strategy is as follows using MONTHLY bars:
1. Long VFINX(SP500) when the price is over the 189 day moving average or monthly equivalent (9sma)
2. When VFINX(SP500) is below monthly 9sma, sell 100% of VFINX(SP500) at next months open and buy VFITX(Bonds)
3. When VFINX(SP500) is above the monthly 9sma, sell 100% of VFITX(Bonds) and 100% re-long VFINX(SP500)

Essentially the strategy is long the S&P500 when its above the 9sma (daily, 189sma) and 100% in intermediate bonds when below the 9sma (daily, 189sma).

The color red denotes times when VFINX(SP500) is below the monthly 9sma (daily, 189sma) and when the strategy would be 100% long bonds.

below9sma

The returns for this strategy since 1991 inception:

Rplot122

vfinx.vfitx.monthly

From the backtest we see an annualized return of 12.4% with a sharpe ratio of 1.21. Maximum draw down is 15% which means we may explore using leverage to boost gains whilst maintaining the same risk profile of buy and hold (VFINX).

We may boost returns by longing a 3x leveraged S&P500 ETF. This can be achieved with ProShares UltraPro ETF(UPRO, inception, 2009). First I want to check to see if we can model UPRO data prior to 2009.

Rplot117

We see from plotting the regression fit of UPRO and 3x SP500 daily returns that the fit is not perfect. There is a high degree of correlation. However, the % return tracking is not exact.

Rplot118

We have almost perfect tracking prior to June 2012. However, there is a notable divergence between the 3x S&P500 daily returns and UPRO.

When we model UPRO prior to 2009 by simply multiplying the S&P500 returns by 3 we know it will be largely theoretical.

Lets back test swapping VFINX with our theoretical UPRO prior to 2009.

Rplot119

upro

Maximum draw down is 45% which is significantly lower than buy and hold UPRO (92%). Essentially we enjoy staggering returns with almost half of the draw down. The 189 daily sma or monthly 9sma acts a 'low pass filter' and avoids the catastrophic bear markets post 1999 and 2007.

Rplot120

cum.ret

We see that cumulative returns are 1276.56%.

This is theoretical but staggering results.

# Get First And Last Date
last.date <- tail(df$Date, n = 1)
first.date <- head(df$Date, n = 1)
## Find Time Difference
time <- last.date - first.date
years.between <- time/352
years.between <- as.numeric(years.between, units="days")   # Extract numerical value from time difference 'Time difference of 2837.208 days'
years.between

10 thousand dollars grows to 12.7 million dollars over a time period of 26.98 years. Not bad for for a maximum draw down of 45% with 3x leverage.

In closing, the 189 daily sma or 9sma monthly equivalent acts as a low pass filter. The aim of this filter is to reduce over all volatility, provide less of a draw down and avoid negative compounding periods. We see from the results that this has been achieved.

Reader Question:
What happens if we optimize the monthly bar SMA look back higher / lower than the tested 9sma?

Full back test R code:


# Long Term S&P500 - Switch To Bonds
# Andrew Bannerman 10.8.2017

require(lubridate)
require(dplyr)
require(magrittr)
require(TTR)
require(zoo)
require(data.table)
require(xts)
require(PerformanceAnalytics)

# Data path
data.dir <- "C:/R Projects/Final Scripts/Vanguard Long Term Strategies"
data.read.VFINX <- paste(data.dir,"VFINX.csv",sep="/")
data.read.VFITX <- paste(data.dir,"VFITX.csv",sep="/")

# Read data
read.VFINX <- read.csv(data.read.VFINX,header=TRUE, sep=",",skip=0,stringsAsFactors=FALSE)
read.VFITX <- read.csv(data.read.VFITX,header=TRUE, sep=",",skip=0,stringsAsFactors=FALSE)
#read.VFITX <- read.VFITX[-nrow(read.VFITX),] 

# Convert Values To Numeric
cols <-c(2:7)
read.VFINX[,cols] %<>% lapply(function(x) as.numeric(as.character(x)))
read.VFITX[,cols] %<>% lapply(function(x) as.numeric(as.character(x)))

#Convert Date Column [1]
read.VFINX$Date <- ymd(read.VFINX$Date)
read.VFITX$Date <- ymd(read.VFITX$Date)

# Merge two data sets
df <- full_join(read.VFINX, read.VFITX, by = c("Date" = "Date"))

# Rename Columns
colnames(df)[1] <-"Date"
colnames(df)[2] <-"VFINX.Open"
colnames(df)[3] <-"VFINX.High"
colnames(df)[4] <-"VFINX.Low"
colnames(df)[5] <-"VFINX.Close"
colnames(df)[6] <-"VFINX.Adj.Close"
colnames(df)[7] <-"VFINX.Volume"
colnames(df)[8] <-"VFITX.Open"
colnames(df)[9] <-"VFITX.High"
colnames(df)[10] <-"VFITX.Low"
colnames(df)[11] <-"VFITX.Close"
colnames(df)[12] <-"VFITX.Adj.Close"
colnames(df)[13] <-"VFITX.Volume"

# Convert all NA to 0
df[is.na(df)] <- 0

# Use TTR package to create rolling SMA n day moving average
# Create function and loop in order to repeat the desired number of SMAs for example 2:30
getSMA <- function(numdays) {
  function(df) {
    SMA(df[,"VFINX.Adj.Close"], numdays)    # Calls TTR package to create SMA
  }
}
# Create a matrix to put the SMAs in
sma.matrix <- matrix(nrow=nrow(df), ncol=0)

# Loop for filling it
for (i in 2:400) {
  sma.matrix <- cbind(sma.matrix, getSMA(i)(df))
}

# Rename columns
colnames(sma.matrix) <- sapply(2:400, function(n)paste("adj.close.sma.n", n, sep=""))

# Bind to existing dataframe
df <-  cbind(df, sma.matrix)

# Convert all NA to 0
df[is.na(df)] <- 0

# Calculate Returns from open to close
#df$VFINX.ocret <- apply(df[,c('VFINX.Open', 'VFINX.Adj.Close')], 1, function(x) { (x[2]-x[1])/x[1]} )
#df$VFITX.ocret <- apply(df[,c('VFITX.Open', 'VFITX.Adj.Close')], 1, function(x) { (x[2]-x[1])/x[1]} )

# Calculate Close-to-Close returns
df$VFINX.clret <- ROC(df$VFINX.Adj.Close, type = c("discrete"))
df$VFITX.clret <- ROC(df$VFITX.Adj.Close, type = c("discrete"))
df$VFINX.clret[1] <- 0
df$VFITX.clret[1] <- 0

# Add leverage multiplier
#df$VFINX.clret <- df$VFINX.clret * 3

# Subset Date
df <- subset(df, Date >= as.POSIXct("1991-10-01") ) 

# Name indicators #
VFINX.sma <- df$adj.close.sma.n9

# Enter buy / sell rules
df$signal.long.stocks <- ifelse(df$VFINX.Adj.Close > VFINX.sma, 1,0)
df$signal.long.bonds <- ifelse(df$VFINX.Adj.Close < VFINX.sma, 1,0)

# lag signal by one forward day to signal entry next day
df$signal.long.stocks <- lag(df$signal.long.stocks,1) # Note k=1 implies a move *forward*
df$signal.long.bonds <- lag(df$signal.long.bonds,1) # Note k=1 implies a move *forward*

df[is.na(df)] <- 0  # Set NA to 0

#Plot VIFNX Monthly with 9sma
plot(df$VFINX.Adj.Close, col = ifelse(df$VFINX.Adj.Close < VFINX.sma,'red','black'), pch = 10, cex=.5,ylab="VFINX Close",main="VFINX Below Monthly 9sma")

# Calculate equity curves
# Long Stocks
df <- df %>%
  dplyr::mutate(RunID = rleid(signal.long.stocks)) %>%
  group_by(RunID) %>%
  dplyr::mutate(long.stocks.equity.curve = ifelse(signal.long.stocks== 0, 0,
                                         ifelse(row_number() == 1, VFINX.clret, VFINX.clret))) %>%
  ungroup() %>%
  select(-RunID)

# Long Bonds
df <- df %>%
  dplyr::mutate(RunID = rleid(signal.long.bonds)) %>%
  group_by(RunID) %>%
  dplyr::mutate(long.bonds.equity.curve = ifelse(signal.long.bonds == 0, 0,
                                                  ifelse(row_number() == 1, VFITX.clret, VFITX.clret))) %>%
  ungroup() %>%
  select(-RunID)

# Combine Signals
df$combined.equity.curve <- df$long.stocks.equity.curve + df$long.bonds.equity.curve

# Pull select columns from data frame to make XTS whilst retaining formats
xts1 = xts(df$long.stocks.equity.curve, order.by=as.Date(df$Date, format="%m/%d/%Y"))
xts2 = xts(df$long.bonds.equity.curve, order.by=as.Date(df$Date, format="%m/%d/%Y"))
xts3 = xts(df$combined.equity.curve, order.by=as.Date(df$Date, format="%m/%d/%Y"))
xts4 = xts(df$VFINX.clret, order.by=as.Date(df$Date, format="%m/%d/%Y")) 

# Join XTS together
compare <- cbind(xts3,xts2,xts1,xts4)

# Use the PerformanceAnalytics package for trade statistics

require(PerformanceAnalytics)
colnames(compare) <- c("Long.Stocks.Switch.Bonds","Long.Bonds","Long.Stocks","Buy And Hold")
charts.PerformanceSummary(compare,main="Long Stocks(VFINX) Over 200sma, Long Bonds(VFITX) Under 200sma", wealth.index=TRUE, colorset=rainbow12equal)
performance.table <- rbind(table.AnnualizedReturns(compare),maxDrawdown(compare), CalmarRatio(compare),table.DownsideRisk(compare))
drawdown.table <- rbind(table.Drawdowns(compare))
#dev.off()
#logRets <- log(cumprod(1+compare))
#chart.TimeSeries(logRets, legend.loc='topleft', colorset=rainbow12equal)

print(performance.table)
print(drawdown.table)
Return.cumulative(xts3, geometric = TRUE)

Author: Andrew Bannerman

Integrity Inspector. Quantitative Analysis is a favorite past time.

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out /  Change )

Google+ photo

You are commenting using your Google+ account. Log Out /  Change )

Twitter picture

You are commenting using your Twitter account. Log Out /  Change )

Facebook photo

You are commenting using your Facebook account. Log Out /  Change )

Connecting to %s