Created
December 1, 2011 18:26
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
require(ttrTests) | |
require(quantmod) | |
require(PerformanceAnalytics) | |
#simple price crossover moving average system | |
#style slightly different to conform to ttrTests | |
oneSMA <- function(x,params=10,burn=0,short=FALSE) { | |
mac2<-runMean(x,params[1]) | |
sig<-ifelse(x>=mac2,1,0) | |
sig[is.na(sig)]<-0 | |
return(sig) | |
} | |
getSymbols("^GSPC",from="1896-01-01",to=Sys.Date()) | |
price.monthly<-to.monthly(GSPC)[,4] | |
price.vector<-as.vector(price.monthly) | |
bsamples=100000 #this takes a while; choose smaller for playing | |
#prepopulate results matrix with NA | |
#for quicker filling later | |
results = matrix(nrow=bsamples,ncol=8) | |
colnames(results) <- c("Drawdown.Sample","Drawdown.System", | |
"Return.Sample","Return.System","SD.Sample","SD.System", | |
"Skewness.Sample","Skewness.System") | |
for (i in 1:bsamples) { | |
sample<-generateSample(price.vector) | |
ret <- as.vector(cReturns(sample,ttr=oneSMA, params=10, burn=0, short=FALSE)[[1]]) | |
results[i,1] <- maxDrawdown( | |
as.xts(ROC(sample,type="discrete",n=1),order.by=index(price.monthly)) | |
) | |
results[i,2] <- maxDrawdown( | |
as.xts(ret,order.by=index(price.monthly)) | |
) | |
results[i,3] <- sample[NROW(sample)]/sample[1]-1 | |
results[i,4] <- cumprod(1+ret)[length(ret)]-1 | |
results[i,5] <- sd(ROC(sample,type="discrete",n=1,na.pad=FALSE)) | |
results[i,6] <- sd(ret) | |
results[i,7] <- skewness(ROC(sample,type="discrete",n=1,na.pad=FALSE)) | |
results[i,8] <- skewness(ret) | |
} | |
par(mfrow=c(2,1)) #2 rows and 1 columns for the boxplot | |
bpdraw <- boxplot((results[,4]-results[,3])~round(results[,1],1), | |
stats=TRUE, main="Boxplot of System Outperformance by Drawdown") | |
bpsd <- boxplot((results[,4]-results[,3])~round(results[,5],3), | |
stats=TRUE, main="Boxplot of System Outperformance by Std. Dev.") | |
#check plot of drawdown versus standard deviation | |
plot(results[,1]~results[,5],pch=16,col="cadetblue4") | |
abline(lm(results[,1]~results[,5]),col="indianred",lwd=2) | |
chart.Correlation(cbind(results,results[,6]-results[,5])) | |
par(mfrow=c(2,1)) #2 rows and 1 columns for the density plots | |
#do the density plot for drawdown | |
d1 <- density(results[,1]) | |
d2 <- density(results[,2]) | |
plot( d2, col=2, lwd=3, main="Density Plot of Sample and System Drawdown") | |
lines( d1, col=4, lwd=3) | |
abline(v=maxDrawdown(ROC(price.monthly,type="discrete",n=1)),col="grey70") | |
text(x=maxDrawdown(ROC(price.monthly,type="discrete",n=1)), y=3.7, pos=3, | |
labels="SP500",srt=90,col="grey70", cex=0.75) | |
legend("topright",legend=c("System","Sample"),col=c(2,4),lwd=3,bty="n") | |
#do the density plot for standard deviation | |
d1 <- density(results[,5]) | |
d2 <- density(results[,6]) | |
plot( d2, col=2, lwd=3, xlim=c(min(d2$x),max(d1$x)), | |
main="Density Plot of Sample and System Std. Dev.") | |
lines( d1, col=4, lwd=3) | |
abline(v=sd(ROC(price.monthly,type="discrete",n=1,na.pad=FALSE)),col="grey70") | |
text(x=sd(ROC(price.monthly,type="discrete",n=1,na.pad=FALSE)), y=3.7, pos=3, | |
labels="SP500",srt=90,col="grey70", cex=0.75) | |
legend("topright",legend=c("System","Sample"),col=c(2,4),lwd=3,bty="n") |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment