Backtesting a Simple Stock Trading Strategy 3

1. Setup.R

rm(list = ls(all = TRUE))
memory.limit(size = 4000)

#Get Data
library(quantmod)
getSymbols('^GSPC',from='1900-01-01')
myStock <- Cl(GSPC)
bmkReturns <- dailyReturn(myStock, type = "arithmetic")

#Apply our strategy to tomorrows returns
#Today's close to tomorrow's close
myReturns <- Next(bmkReturns)
myReturns[nrow(myReturns)] <- 0 
	
#Functions
daysSinceHigh <- function(x, n){
   apply(embed(x, n), 1, which.max)-1
}

2. DaysSinceHigh.R

highs <- seq(5,500,by=5)
highMatrix <- matrix(data=NA,nrow=length(myStock),ncol=length(highs))
colnames(highMatrix) <- highs
for (nHigh in highs) {
	out <- daysSinceHigh(myStock,nHigh)
	out <- c(rep(NA,nHigh-1),out)
	highMatrix[,as.character(nHigh)] <- out
}
 head(na.omit(highMatrix))

3. Holding Periods.R

#Calculate Returns for various combinations of n-day highs and holding periods
holds <- seq(5,500,by=5)
returnsList <- list(NA)
for (nHold in holds) {
	out <- ifelse(highMatrix<=nHold,1,0)
	out <- ifelse(is.na(out),0,out)
	out <- sweep(out,MARGIN=1,myReturns,`*`)
	returnsList[[as.character(nHold)]] <- out
}
returnsList[[1]] <- NULL
str(returnsList)

4. Returns.R

#Calculate Cumulative Returns for various scenarios
cumRet <- as.list(rep(NA,length(returnsList)))
i=1
for (returnMatrix in returnsList) {
	cumRet[[i]] <- apply(returnMatrix,MARGIN=2,function(x) prod(1 + x) - 1)
	i <- i+1
}
cumRet <- unlist(cumRet)
bmkRet <- prod(1 + bmkReturns) - 1
exRet <- cumRet-bmkRet

5. Chart.R

#Custom Color Ramp Function
range01 <- function(x)(x-min(x))/diff(range(x))
cRamp <- function(x){
  cols <- colorRamp(topo.colors(10))(range01(x))
  apply(cols, 1, function(xt)rgb(xt[1], xt[2], xt[3], maxColorValue=255))
}  

#Plot
Data <- data.frame(expand.grid(nHigh=highs,nHold=holds),exRet=exRet)
Data <- Data[Data$nHold<=Data$nHigh,]
plot(Data[,c(1,2)],col=cRamp(Data$exRet),pch=19,lwd=2)

6. 3D Chart.R

#Plot 3D
library(rgl)
ExcessReturns <- matrix(exRet, length(highs), length(holds))
nHigh<-highs
nHold<-holds
persp3d(x=nHigh, y=nHold, z=ExcessReturns, box=FALSE, col=cRamp(ExcessReturns))