|
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) |