Bond Timer for S&P500 (Part 2)

As I said the other day when posting Part 1, I was tired. I also don’t wish to delete older posts that may be of little value, rather I want to keep my workings and progress. Maybe a symbolic way of dealing with my “Shadow”. For those readers not into geekish financial maths, give this post a miss.

Let us have another look at the results, this time with some tweaks to the approach and then we will go into some more depth trying to establish whether this method truly adds value to the Buy and Hold approach.

We start by downloading S&P500 and US 10yr Treasury data from Quandl going back to 1962 so we have 53 years of data. I would actually like to use a lot more data as I fear that the secular bond bull cycle may be distorting our results. We create a ratio by dividing the S&P500 by the bond yield (I think working with nominal index and not using log returns may be an issue worth looking into). Once we have a ratio we then smooth it out with a 50 and 200 day moving average. The signal trigger in our model then is to buy the market whenever the 50 day moving average of the ratio is greater than the 200 day. It is quite hard to see on this chart but you can at least see the shape of the ratio relative to the S&P500 (black):

Rplot

So lets look at the results:

2014-12-25_1612

According to the results from 1962 the Sharpe Ratio of the Ratio Cross vs Buy&Hold is better 0.50 vs 0.32. You can also see a superior Max DrawDown ratio, we do not focus on absolute return where buy and hold outperforms as our stated objective is to always focus on risk adjusted returns. I include the tail(sig_ratio) so that you can see that the system is invested at the moment.

Rplot07

 

We now try a different study and look at the Sharpe Ratio on a yearly basis and then look at the mean of the 53 years. Here I get a confusing result which I don’t know how to explain, it seems to say that the Ratio Cross has a Sharpe Ratio of 0.60 vs 0.70 hmmm???. So to take this one step further I tested the market timing ability of my Bond Timer with the Treynor-Mazuy quadratic regression approach, and you can see below that the system produces alpha, which seems to suggest that the Bond Timer is providing market timing value add. Btw, the MarketTiming() function isn’t in the Performance Analytics package on CRAN so I have included the function in my code below.

2014-12-25_1618

Conclusion:

This is still very much a work in progress but I believe the ratio timing method adds value to a buy and hold approach, however I need to explain why I am getting a conflicting result when looking at Sharpe Ratio’s of 1 year at a time.

require(quantmod)
require(PerformanceAnalytics)
require(Quandl)
 
start<- "1962-01-02"
#get the data (S&P500 and US 10yr Treasury)
spy<- Quandl("YAHOO/INDEX_GSPC", authcode="kvYEqCqKCTyL4anWz5Zv", type="xts")
bond<- Quandl("FRED/DGS10", authcode="kvYEqCqKCTyL4anWz5Zv", type="xts")
 
data<- merge(spy[,6],bond[,1])
data<- data["1999::"]
 
# This is the magic signal or is it? It is the Nominal Price of the S&P500 / bond yield. 
# The fact that it is nominal worries me. 
ratio<- data[,1]/data[,2]
ratio<- na.omit(ratio)
# moving averages of the ratio
ratio_short<- rollmean(ratio, k=50, align= "right")
ratio_long<- rollmean(ratio, k=200, align= "right")
 
# I like visual references ignore the red errors in the output console I am too lazy to fix up the axis.
plot(data[,1], main="Mike's Bond Timer")
par(new=TRUE)
plot(ratio_long, col ='red')
axis(4)
par(new=TRUE)
plot(ratio_short, col ='green')
par(new=TRUE)
plot(ratio, col ='blue')
 
#our baseline, unfiltered results
ret <- ROC(data[,1])
 
#our comparision, filtered result. The idea being to trade the short ratio while it is above the long ratio.
sig_ratio <- Lag(ifelse(ratio_short > ratio_long, 1, 0))
sig_ret <- ret * sig_ratio
 
btimer<- cbind(sig_ret, ret)
colnames(btimer) = c('Ratio Cross', 'Buy&Hold')
 
table.AnnualizedReturns(btimer, Rf= 0)
charts.PerformanceSummary(btimer, Rf = 0, main="Bond Timer",geometric=FALSE)
maxDrawdown(btimer)
tail(sig_ratio)
 
# This looks at the Sharpe Ratio on an annual basis as opposed to the whole period.
years <- apply.yearly(btimer, SharpeRatio.annualized)
 
# In order to get rid of NaN's this function I found on StackFlow helps convert them to zero.
is.nan.data.frame <- function(x)
  do.call(cbind, lapply(x, is.nan))
years[is.nan(years)] <- 0
years
sapply(years, mean)
 
# Market Timing Function which is not part of the CRAN release.
MarketTiming <- function (Ra, Rb, Rf = 0, method = c("TM", "HM"))
{ # @author Andrii Babii, Peter Carl
 
  # FUNCTION
 
  Ra = checkData(Ra)
  Rb = checkData(Rb)
  if (!is.null(dim(Rf))) 
    Rf = checkData(Rf)
  Ra.ncols = NCOL(Ra)
  Rb.ncols = NCOL(Rb)
  pairs = expand.grid(1:Ra.ncols, 1)
  method = method[1]
  xRa = Return.excess(Ra, Rf)
  xRb = Return.excess(Rb, Rf)
 
  mt <- function (xRa, xRb)
  {
    switch(method,
           "HM" = { S = xRb > 0 },
           "TM" = { S = xRb }
    )
    R = merge(xRa, xRb, xRb*S)
    R.df = as.data.frame(R)
    model = lm(R.df[, 1] ~ 1 + ., data = R.df[, -1])
    return(coef(model))
  }
 
  result = apply(pairs, 1, FUN = function(n, xRa, xRb) 
    mt(xRa[, n[1]], xRb[, 1]), xRa = xRa, xRb = xRb)
  result = t(result)
 
  if (ncol(Rb) > 1){
    for (i in 2:ncol(xRb)){
      res = apply(pairs, 1, FUN = function(n, xRa, xRb) 
        mt(xRa[, n[1]], xRb[, i]), xRa = xRa, xRb = xRb)
      res = t(res)
      result = rbind(result, res)
    }
  }
 
  rownames(result) = paste(rep(colnames(Ra), ncol(Rb)), "to",  rep(colnames(Rb), each = ncol(Ra)))
  colnames(result) = c("Alpha", "Beta", "Gamma")
  return(result)
}
print(MarketTiming(years[,1],years[,2],Rf=0))

Created by Pretty R at inside-R.org

Bond Timer for S&P500

It is late and I am tired, but I wanted to quickly explore an idea, where I use the ratio of the S&P500 divided by the US 10yr Treasury note yield as the trigger for when to get in and out of the S&P500. I have lots of things to check to see if this spurious or not, but none the less this is the code I came up with.

But before we look at the code you can see some nice out performance of the index. I haven’t factored in transaction costs or spread. Will check and amend if this is likely to be material.

2014-12-22_2245

Rplot01

Some visuals of the indicators

Rplot2

Finally the code:  [Post script: On the 25th of December I improved on the findings originally posted here. I don’t like to delete my workings as I like to have a source of reference for the progression of my thinking.]

require(quantmod)
require(PerformanceAnalytics)
require(Quandl)
 
start<- "1962-01-02"
#get the data (S&P500 and US 10yr Treasury)
spy<- Quandl("YAHOO/INDEX_GSPC", authcode="kvYEqCqKCTyL4anWz5Zv", type="xts")
bond<- Quandl("FRED/DGS10", authcode="kvYEqCqKCTyL4anWz5Zv", type="xts")
 
data<- merge(spy[,6],bond[,1])
data<- data["1962::"]
 
# This is the magic signal or is it? It is the Nominal Price of the S&P500 / bond yield. 
# The fact that it is nominal worries me. 
ratio<- data[,1]/data[,2]
ratio<- na.omit(ratio)
# moving averages of the ratio
ratio_short<- rollmean(ratio, k=20, align= "right")
ratio_long<- rollmean(ratio, k=100, align= "right")
 
# I like visual references ignore the red errors in the output console I am too lazy to fix up the axis.
plot(data[,1], main="Mike's Bond Timer")
par(new=TRUE)
plot(ratio_long, col ='red')
axis(4)
par(new=TRUE)
plot(ratio_short, col ='green')
par(new=TRUE)
plot(ratio, col ='blue')
 
 
#our baseline, unfiltered results
ret <- ROC(data[,1])
 
#our comparision, filtered result. The idea being to trade the ratio while it is above the long term m.average
sig_long <- Lag(ifelse(ratio > ratio_long, 1, 0))
sig_short <- Lag(ifelse(ratio > ratio_short, 1, 0))
sig_long <- ret * sig_long
sig_short <- ret * sig_short
 
 
btimer<- cbind(sig_long, sig_short, ret)
colnames(btimer) = c('BT Long', 'BT Short','Buy&Hold')
 
table.AnnualizedReturns(btimer, Rf= 0.02/252)
charts.PerformanceSummary(btimer, Rf = 0.02, main="Bond Timer",geometric=FALSE)
maxDrawdown(btimer)
tail(ma_sig)

Created by Pretty R at inside-R.org

 

Global Stock Index Watchlist

I am really pretty chuffed with my effort, I spent many hours today working on this R code. I haven’t commented it like I should because it is not yet a complete product. For those who don’t know, R is an open source statistical mathematical programming language, that has taken the data analytic world by storm. I am a novice at writing scripts but enjoy learning; it is my latest hobby.

Here is the output and code which any of you can run on your own PC, the data is from Yahoo. I notice Russia is missing so I must make an effort to include for my next post.

Global Stock Index Watchlist % change

require(quantmod)
require(PerformanceAnalytics)
require(gridExtra)
 
 
# select ticker symbols and time frame from Yahoo World Indexes
index <- c("^AORD",  "^SSEC",	"^HSI",	"^BSESN",	"^JKSE",	"^KLSE",	"^N225",	"^NZ50",	"^STI",	"^KS11",	"^TWII",	"^GSPTSE",	"^GSPC",	"^ATX",	"^BFX",	"^FCHI",	"^GDAXI",	"^SSMI",	"^FTSE",	"GD.AT
")
date_begin <- as.Date("2009-03-01")
date_end <- as.Date("2014-12-31")
 
tickers <- getSymbols(index, from=date_begin, to=date_end, auto.assign=TRUE)
 
dataset <- Ad(get(tickers[1]))
for (i in 2:length(tickers)) { dataset <- merge(dataset, Ad(get(tickers[i]))) }
 
# handle NA values 
data <- na.locf(dataset) # last observation carried forward to get rid of the NA's
data <- na.omit(data) # omit values with NA values
 
# daily returns
daily <- dailyReturn(data[,1])
for (i in 2:ncol(data)) 
    { daily <- merge(daily, dailyReturn(data[,i]))  
    } 
colnames(daily) <- index
day<- tail(daily,n=1)
 
# weekly returns
weekly <- weeklyReturn(data[,1])
for (i in 2:ncol(data)) 
    { weekly <- merge(weekly, weeklyReturn(data[,i]))  
    } 
colnames(weekly) <- index
week<- tail(weekly,n=1)
 
# monthly returns
monthly <- monthlyReturn(data[,1])
for (i in 2:ncol(data)) 
    { monthly <- merge(monthly, monthlyReturn(data[,i]))  
    } 
colnames(monthly) <- index
month<- tail(monthly,n=1)
 
# quarterly returns
quarterly <- quarterlyReturn(data[,1])
for (i in 2:ncol(data)) 
    { quarterly <- merge(quarterly, quarterlyReturn(data[,i]))  
    } 
colnames(quarterly) <- index
quarter<- tail(quarterly,n=1)
 
# Annual returns
annual <- annualReturn(data[,1])
for (i in 2:ncol(data)) 
    { annual <- merge(annual, annualReturn(data[,i]))  
    } 
colnames(annual) <- index
year<- tail(annual,n=1)
 
summary<- rbind(day,week,month,quarter,year)
colnames(summary) <- c("Aussie", "China", "Hong Kong", "India", "Indonesia", "Malaysia", "Japan", "New Zealand", "Singapore", "Korea", "Taiwan", "Canada", "S&P500", "Austria", "Belgium", "France", "Germany", "Swiss", "UK", "Greece")
 
 
# transpose the data
global<- t(summary)
colnames(global)<- c('Daily','Weekly','Monthly','Quarterly','Annual')
global<- as.data.frame(global) 
 
is.num<- sapply(global, is.numeric)
global[is.num]<- lapply(global[is.num], round,4)
global<- global*100
 
print(global)
grid.newpage(recording = FALSE)
grid.table(global)

Created by Pretty R at inside-R.org

GDP threshold Strategy

As a continuation of my analysis on the relationship between GDP and the markets, it is clear to see that if you place a simple threshold (the quarterly annualized GDP growth needs to be above zero) to your buy and hold then you significantly improve a vanilla buy and hold strategy. See results and code below. Sharpe Ratio improved from 0.49 to 0.61

Rplot Rplot02

 

library(quantmod)
library(Quandl)
library(PerformanceAnalytics)
library(gridExtra)
 
#Getting data from Quandl
GDP<- Quandl("FRED/GDP", trim_start="1947-01-01", trim_end="2014-07-01", transformation="rdiff", authcode="kvYEqCqKCTyL4anWz5Zv", type = "xts")
SP500<- Quandl("YAHOO/INDEX_GSPC", trim_start="1950-01-03", trim_end="2014-11-21", authcode="kvYEqCqKCTyL4anWz5Zv", type = "xts")
 
#need to make SP500 data quartetly using the quantmod function.
SP.q<- quarterlyReturn(SP500[,6], subset=NULL, type='arithmetic', leading=FALSE)
 
#cleaning up and aligning the data frame, I know this is fuzzy logic I am a novice coder
df1<- merge(GDP,SP.q)
df2<- merge(lag(df1[,1], k=1),df1)
m<- merge(df2[,1],df2[,3])
mt<- na.omit(m)
mb<- lag(mt[,2],k=1)
mc<- lag(mt[,2],k=2)
mt<- cbind(mt,mb,mc)
mt<- na.omit(mt)
colnames(mt) <- c("GDP", "S&P", "S&P -1", "S&P -2")
head(mt)
 
# Signal
gdp_sig <- ifelse(mt[,1] > 0, 1, 0)  ## I took out the lag function because of the built in lag in the DF
gdp_ret <- mt[,3] * gdp_sig
 
golden<- cbind(gdp_ret,mt[,3])
colnames(golden) = c('GDPtrigger','Buy&Hold')
 
t<- table.AnnualizedReturns(golden, Rf= 0)
grid.newpage(recording = FALSE)
grid.table(t)
 
charts.PerformanceSummary(golden, Rf = 0, main="GDP",geometric=FALSE)

Created by Pretty R at inside-R.org

GDP correlation to S&P500

I have been wanting to do this analysis for some time, and I always seem to be interrupted. I want to stress that I still need to validate my findings but they kind of gel with my intuition. [I have included my R code below]

GDP S&P S&P -1 S&P -2
GDP correlation 100% 2.67% 17.43% 24.04%
Adj. R Square -0.30% 2.65% 5.41%

Ok so what do we have here. Every time we get a GDP release, ignore the revisions and all the noise around the announcement for this exercise, people straight away extrapolate its effect on the stock market, i.e. a high GDP growth rate will correlate with a high quarterly performance . In our study we simply want to know what the correlation coefficient is of the S&P500 and the quarterly GDP growth figure. As you can see it is very low there is a 2.67% correlation (one of my questions to investigate is the GDP data is annualized quarterly data, whereas the S&P500 is simply quarterly so this could be a factor. The adjusted R2 is totally insignificant.

What is noticeable and quite significant is if you lag the performance of the S&P500 by 1 and 2 quarters you get a statistically significant relationship. So a 2 quarter lag is even better than 1, which in my mind makes sense, that the benefits to the market filter through slowly. These are rough workings and will require more input from me.
Postscript: just been thinking about it in the steamshower. GDP numbers are released roughly a quarter after the fact so the observation that the same quarters have no correlation actually makes sense. Something else to add is that I am going to do the study on raw quarterly data as well to see if this increases the correlation and R2 I think it will

library(quantmod)
library(Quandl)
 
#Getting data from Quandl
GDP<- Quandl("FRED/GDP", trim_start="1947-01-01", trim_end="2014-07-01", transformation="rdiff", authcode="kvYEqCqKCTyL4anWz5Zv", type = "xts")
SP500<- Quandl("YAHOO/INDEX_GSPC", trim_start="1950-01-03", trim_end="2014-11-21", authcode="kvYEqCqKCTyL4anWz5Zv", type = "xts")
 
#need to make SP500 data quartetly using the quantmod function.
SP.q<- quarterlyReturn(SP500[,6], subset=NULL, type='arithmetic', leading=FALSE)
 
#cleaning up and aligning the data frame, I know this is fuzzy logic I am a novice coder
df1<- merge(GDP,SP.q)
df2<- merge(lag(df1[,1], k=1),df1)
m<- merge(df2[,1],df2[,3])
mt<- na.omit(m)
mb<- lag(mt[,2],k=1)
mc<- lag(mt[,2],k=2)
mt<- cbind(mt,mb,mc)
mt<- na.omit(mt)
colnames(mt) <- c("GDP", "S&P", "S&P -1", "S&P -2")
head(mt)
 
#regression analysis
regression<- lm(mt[,1] ~ mt[,2])
 
#lagging S&P500 by 1 quarter
regression1<- lm(mt[,1] ~ mt[,3])
 
#lagging S&P500 by 2 quarter
regression2<- lm(mt[,1] ~ mt[,4])
 
#statistical analysis
cor(mt)*100
summary(regression)$adj.r.squared *100
summary(regression1)$adj.r.squared *100
summary(regression2)$adj.r.squared *100
 
#plotting regressions
plot(regression)
plot(regression1)
plot(regression2)

Created by Pretty R at inside-R.org

 

My Shiller Model

I had a quick look at my trusted Shiller Model which actually went to cash mid October this year. It continues to suggest holding onto cash. I attach the r code I used to build it, and I can apologize in advance for my sloppy coding, but it does most of the job. I plan on cleaning the code up in the near future.

Rplot05 Rplot04

library(quantmod)
library(PerformanceAnalytics)
library(gridExtra)
 
# I am pulling the data from Quandl and the MULTPL dataset. 
multpl<- read.csv('https://www.quandl.com/api/v1/datasets/MULTPL/SHILLER_PE_RATIO_MONTH.csv?trim_start=1881-01-01&trim_end=2014-12-17&auth_token=CqKCTyL4anWz5Zv', colClasses=c('Date'='Date'))
snp<- read.csv('https://www.quandl.com/api/v1/datasets/MULTPL/SP500_REAL_PRICE_MONTH.csv?trim_start=1871-01-01&trim_end=2014-12-17&auth_token=CqKCTyL4anWz5Zv', colClasses=c('Date'='Date'))
 
date<- snp$Date
values<- snp[,2]
snp.obj<- as.xts(values, order.by = as.Date(date, "%d/%m/%Y"))
snprets<- ROC(snp.obj, type = "discrete", n = 1)
 
date<- multpl$Date
values<- multpl[,2]
PE.obj<- as.xts(values, order.by = as.Date(date, "%d/%m/%Y"))
 
Shiller<- merge(snp.obj,PE.obj, snprets)
Shiller.sub = Shiller['1900-01-01::']
colnames(Shiller.sub) = c('S&P500','Shiller PE','S&P500 returns')
 
mean<- rollapply(PE.obj,48,mean)
sdsig<- rollapply(PE.obj,48,sd) + mean
over<- Lag(ifelse(PE.obj> sdsig,1,0))
 
pe_ret <- snprets * over
PEtimer<- cbind(pe_ret,snprets) 
colnames(PEtimer) = c('PE-Timer','Buy&Hold')
 
maxDrawdown(PEtimer)
grid.newpage(recording = FALSE)
grid.table(tail(over))
tail(over)
grid.newpage(recording = FALSE)
grid.table(table.AnnualizedReturns(PEtimer, Rf=0))
table.AnnualizedReturns(PEtimer, Rf= 0)
charts.PerformanceSummary(PEtimer, Rf = 0, main="Shiller PE Timer",geometric=FALSE)

Created by Pretty R at inside-R.org