system test with additions

  • Download Gist
system test with 401k type additions.r
R
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115
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)

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.