Drawdown Look at Frontier of Assets and Systems
[This article was first published on Timely Portfolio, and kindly contributed to R-bloggers]. (You can report issue about the content on this page here)
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.
In Efficient Frontier of Funds and Allocation Systems, I had hoped to start exploring how a frontier can potentially be created with only one asset, or how an even more efficient frontier could be created with assets and also systems on those assets. I am obsessed with drawdown, so of course I need to extend that post with a look at drawdown to satisfy this obsession. If you have not read the original post, please read it before this, since I will only show the additional graph created.
![]() |
From TimelyPortfolio |
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(quantmod) | |
require(PerformanceAnalytics) | |
getSymbols("VFINX",from="1990-01-01",adjust=TRUE) | |
getSymbols("VBMFX",from="1990-01-01",adjust=TRUE) | |
perf <- na.omit(merge(monthlyReturn(VBMFX[,4]),monthlyReturn(VFINX[,4]))) | |
colnames(perf) <- c("VBMFX","VFINX") | |
#get 8 month RSI; randomly picked 8; no optimization | |
rsi<- lag(merge(RSI(perf[,1],n=8),RSI(perf[,2],n=8)),k=1) | |
#allocate between vbmfx and vfinx based on highest RSI | |
rsi.perf <- ifelse(rsi[,1]>rsi[,2],perf[,1],perf[,2]) | |
rsi.each <- as.xts(as.matrix(rsi>50) * as.matrix(perf), | |
order.by=index(perf)) | |
#get cumulative returns for moving average | |
cumul <- as.xts(apply(perf+1,MARGIN=2,cumprod),order.by=index(perf)) | |
#do 10 month Mebane Faber style system | |
ma <- lag(merge(runMean(cumul[,1],n=10),runMean(cumul[,2],n=10)),k=1) | |
#apply 50% allocation to each fund if they are > 10 month moving average | |
ma.perf <- as.xts(apply(as.matrix(cumul>ma) * as.matrix(perf)/2, | |
MARGIN=1,sum), | |
order.by=index(perf)) | |
ma.each <- as.xts(as.matrix(cumul>ma) * as.matrix(perf), | |
order.by=index(perf)) | |
#add omega as another allocation method | |
omega <- lag(merge(apply.rolling(perf[,1],width=6,by=1,FUN=Omega), | |
apply.rolling(perf[,2],width=6,by=1,FUN=Omega)), | |
k=1) | |
#if omega >= 1 then apply 50% allocation | |
omega.perf <- as.xts(apply(as.matrix(omega>=1) * as.matrix(perf)/2, | |
MARGIN=1,sum), | |
order.by=index(perf)) | |
omega.each <- as.xts(as.matrix(omega>=1) * as.matrix(perf), | |
order.by=index(perf)) | |
perf.all <- merge(perf,rsi.perf,rsi.each,ma.perf,ma.each,omega.perf,omega.each) | |
perf.all[is.na(perf.all)]<-0 | |
colnames(perf.all) <- c(colnames(perf),paste(c(rep("rsi",3),rep("ma",3),rep("omega",3)), | |
c("",".VBMFX",".VFINX"),sep="")) | |
#now let's add two very basic systems | |
#and explore on Systematic Investor's efficient frontier | |
######################################################## | |
#continue to highlight the very fine work of | |
#http://systematicinvestor.wordpress.com/ | |
#adapted some of his code to provide | |
#a not-so-novel additional example for | |
#those that might be interested | |
####################################################### | |
# Load Systematic Investor Toolbox (SIT) | |
con = gzcon(url('https://github.com/systematicinvestor/SIT/raw/master/sit.gz', 'rb')) | |
source(con) | |
close(con) | |
#-------------------------------------------------------------------------- | |
# Create Efficient Frontier | |
#-------------------------------------------------------------------------- | |
ia = list() | |
#amend to use the funds and basic systems | |
ia$symbols = colnames(perf.all) | |
ia$n = len(ia$symbols) | |
#use PerformanceAnalytics tables to get return (geometric) and risk | |
#for the entire period | |
ia$expected.return = as.matrix(t(table.Stats(perf.all)[7,])) | |
ia$risk = as.matrix(t(table.Stats(perf.all)[14,])) | |
ia$correlation = cor(perf.all) | |
ia$cov = cov(perf.all) | |
n = ia$n | |
# 0 <= x.i <= 1 | |
constraints = new.constraints(n, lb = 0, ub = 1) | |
# SUM x.i = 1 | |
constraints = add.constraints(rep(1, n), 1, type = '=', constraints) | |
# create efficient frontier | |
ef.risk = portopt(ia, constraints, 50) | |
#I am getting an error here | |
#plot.ef(ia, ef.risk), transition.map=TRUE) | |
#know what is happening but not motivated to fix | |
#"Error in x$weight : $ operator is invalid for atomic vectors" | |
#will do manually plot | |
colors <- c("purple","indianred3","steelblue2","steelblue3","steelblue4", | |
"darkolivegreen2","darkolivegreen3","darkolivegreen4", | |
"chocolate2","chocolate3","chocolate4") | |
plot(ef.risk$return~ef.risk$risk,col="grey60",lwd=3,type="l", | |
xlim=c(min(ia$risk),max(ia$risk)+.01), | |
ylim=c(min(ia$expected.return),max(ia$expected.return))) | |
points(x=as.numeric(ia$risk),y=as.numeric(ia$expected.return),pch=19, | |
col=colors,cex=1.5) | |
text(x=as.numeric(ia$risk),y=as.numeric(ia$expected.return), | |
labels=ia$symbols,pos=4,col=colors) | |
title(main="Efficient Frontier of VBMFX and VFINX and Systematic Allocation", | |
adj=0,outer=TRUE,line=-1) | |
plot.transition.map(ef.risk,col=colors) | |
chart.CumReturns(perf.all,colorset=colors, | |
main="Growth of VBMFX and VFINX and Systematic Allocations", | |
legend.loc="topleft") | |
#I am sure there is a better way to do this | |
#this function will calculate the maxDrawdown for each of the point allocations | |
#from the systematic investor (SIT) frontier calculated above | |
#if there is not a better way then you're welcome | |
frontier.drawdown <- function(weight,perfxts) { | |
point.drawdown <- matrix(nrow=NROW(weight)) | |
for (i in 1:NROW(weight)) { | |
weight.matrix <- matrix(rep(weight[i,],NROW(perfxts)),byrow=TRUE,nrow=NROW(perfxts),ncol=NCOL(weight)) | |
point.drawdown[i] <- maxDrawdown(as.matrix(apply((weight.matrix * perfxts),MARGIN=1,sum))) | |
} | |
return(point.drawdown) | |
} | |
drawdown <- frontier.drawdown(weight=ef.risk$weight,perfxts=perf.all) | |
#set outer margin on top to get the title in a better spot | |
par(oma=c(0,1,2,0)) | |
#do frontier style plot with drawdown as the risk measure | |
plot(-t(maxDrawdown(perf.all)),ia$expected.return, | |
col=colors,xlim=c(-0.6,0),pch=19,cex=1.25, | |
xlab="drawdown",ylab="monthly return",bty="u") | |
#add a right side axis since 0 is the origin and drawdown is negative | |
axis(side=4,lwd=0,lwd.ticks=1) | |
#add labels for each of the points | |
text(x=-t(maxDrawdown(perf.all)),y=ia$expected.return,labels=ia$symbols,pos=2,col=colors,cex=0.75) | |
#add the frontier line generated from normal optimization of mean and return | |
points(x=-drawdown,y=ef.risk$return,type="l",lwd=2,col="grey50") | |
title(main="Efficient Frontier with Drawdown as Risk Measure",adj=0,outer=TRUE) |
To leave a comment for the author, please follow the link and comment on their blog: Timely Portfolio.
R-bloggers.com offers daily e-mail updates about R news and tutorials about learning R and many other topics. Click here if you're looking to post or find an R/data-science job.
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.