system test with additions

system test with 401k type additions.r

require(PerformanceAnalytics)
require(quantmod)


getSymbols("^GSPC", from = "1900-01-01")
#get return series from closing price
ret.bh <- ROC(GSPC[,4],n = 1,type = "discrete")
#change first value from NA to 0
ret.bh[1,] <- 0

#set nper for moving average system
nper <- 200  #200 for approximation of 10 month
#get returns for moving average system
ret.ma <- lag(ifelse(GSPC[,4] > runMean(GSPC[,4], n = nper), 1, 0),k = 1) * ret.bh
ret.ma[is.na(ret.ma)] <- 0

ret <- merge(ret.bh,ret.ma)
colnames(ret) <- c("SP500.buyhold","SP500.ma")

#do analysis without money add framework
charts.PerformanceSummary(ret, colorset=c("gray60","steelblue3"), lwd=c(1,2),
                          main = "S&P 500 BuyHold and Moving Average")

#set up a very basic framework
#for a situation similar to 401k
#where money is periodically added
startmoney = 100000
lastmoney = rep(startmoney,2)
#this 60 is a crude approximation of quarterly
addfreq = 60
#this is the deposit
#in this case 10% of starting capital added per year or 2.5% per quarter
deposit = startmoney[1] * 0.10 / 4 #floor(250/addfreq)

#copy structure of ret for the portfolio series
portfolio <- merge(ret.bh, ret.ma)
#set all portfolio to be equal to starting capital
portfolio[] <- startmoney
colnames(portfolio) <- c("SP500.buyhold","SP500.ma")

#know this is not a pretty way to do this
#use quantstrat for more robust portfolio accounting and testing
for (i in 1:NROW(GSPC)) {
  #deposit money each addfreq days
  if (i %% addfreq == 0) {
    portfolio[i,] = c((lastmoney[1] + deposit) * (1 + ret.bh[i]), (lastmoney[2] + deposit) * (1 + ret.ma[i]))
    lastmoney = as.vector(portfolio[i,])
  #all other periods just get return of sp500
  } else {
    portfolio[i,] = c(lastmoney[1] * (1 + ret.bh[i]), lastmoney[2] * (1 + ret.ma[i]))
    lastmoney = as.vector(portfolio[i,])
  }
}

#very slightly amend the default panel to do log scale of y axis
#but have everything still work and also label non log
slightly.changed.panel <- function(index,x,...) {
  default.panel(index,x,...)
  abline(h=pretty(c(par("yaxp")[1],par("yaxp")[2]),n=abs(par("yaxp")[3])),col="gray60",lty=3,lwd=0.5)
  #way too much manual intervention
  axis(side=2,col="gray60",col.axis="black",lwd=1,las=1,
       at=pretty(c(par("yaxp")[1],par("yaxp")[2]),n=abs(par("yaxp")[3]))[c(1,3,5)],
       labels=10^pretty(c(par("yaxp")[1],par("yaxp")[2]),n=abs(par("yaxp")[3]))[c(1,3,5)]
       )
  abline(h=par("usr")[3])
}

drawdown.panel <-  function(index,x,...) {  
  mtext("Drawdown", side=1, adj=1, line=-2) 
  default.panel(index,x,...)
  #silly to do this but if we wanted just certain points like every 4 months we could do something like this
  #default.panel(index[seq(1,NROW(index),by=4)],coredata(x[seq(1,NROW(index),by=4)]),...)
  #abline(h=0, col="black")
  abline(h=pretty(c(par("yaxp")[1],par("yaxp")[2]),n=par("yaxp")[3]),col="gray60",lty=3)
  axis(side=2,at=pretty(c(par("yaxp")[1],par("yaxp")[2]),n=par("yaxp")[3]),col="gray60", col.axis="black", las=1)
  abline(h=par("usr")[3], col="black")
}


plot.xts(na.omit(merge(log10(portfolio),Drawdowns(ROC(portfolio),n=1,type="discrete"))),
         screens=c(1,1,2,2),
         layout.screens=c(1,1,2),
         auto.legend=TRUE,legend.loc=c("topleft",NA),
         legend.pars = list(bty = "n", horiz=TRUE),  
         #log="y",
         col=c("gray70","steelblue3"),
         lwd=c(1,2),
         bty="n",
         auto.grid=FALSE,
         major.format="%Y",
         minor.ticks=FALSE,
         col.axis="transparent",
         cex.axis=0.9,
         panel=c(slightly.changed.panel,drawdown.panel),
         main=NA)
title(main="S&P 500 Strategy Comparison with 401k Style Additions", outer=TRUE, line=-2, adj= 0.05)

#clients don't think in log terms so rerun without log scale
plot.xts(na.omit(merge(portfolio,Drawdowns(ROC(portfolio),n=1,type="discrete"))),
         screens=c(1,1,2,2),
         layout.screens=c(1,1,2),
         auto.legend=TRUE,legend.loc=c("topleft",NA),
         legend.pars = list(bty = "n", horiz=TRUE),  
         #log="y",
         col=c("gray70","steelblue3"),
         lwd=c(1,2),
         bty="n",
         auto.grid=FALSE,
         major.format="%Y",
         minor.ticks=FALSE,
         col.axis="transparent",
         cex.axis=0.9,
         panel=c(default.panel,drawdown.panel),
         main=NA)
title(main="S&P 500 Strategy Comparison with 401k Style Additions", outer=TRUE, line=-2, adj= 0.05)