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.

The returns for this strategy since 1991 inception:

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.

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.

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.

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.

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)