frontier with systematic investor - drawdown.r

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)