Tale of Two Frontiers

taleoftwo.r

require(quantmod)
require(PerformanceAnalytics)
require(PortfolioAnalytics)
require(fPortfolio)
require(ggplot2)

#read a csv file of returns
#unfortunately I cannot share
portfolio <- read.csv("iv stocks bonds international.csv",stringsAsFactors=FALSE)
portfolio <- portfolio[2:NROW(portfolio),2:NCOL(portfolio)]
#for indicies
#portfolio <- portfolio[,c(1,3,5,7,9,11,13,15,17,19)]
#for ivfrontier
portfolio <- portfolio[,c(1,3,5,7,9,11,13)]

#since export has duplicate colnames we need to remove the .1 added
#colnames(portfolio) <- substr(colnames(portfolio),1,nchar(colnames(portfolio))-2)

len <- nchar(portfolio[,1])
xtsdate <- paste(substr(portfolio[,1],len-3,len),"-",
	ifelse(len==9,"0",""),substr(portfolio[,1],1,len-8),"-01",sep="")
portfolio.xts <- xts(data.matrix(portfolio[,2:NCOL(portfolio)]),order.by=as.Date(xtsdate))
portfolio.xts <- portfolio.xts/100
portfolio.xts[1,]<-0


mycolors = c(topo.colors(7)[c(1:4)],"indianred3","burlywood4")
frontier <- portfolioFrontier(as.timeSeries(portfolio.xts["2000::"]))
#frontier <- portfolioFrontier(as.timeSeries(portfolio.xts["1950::1999"]))

pointsFrontier = frontierPoints(frontier, frontier = "both", auto=TRUE)
targetRisk = getTargetRisk(frontier@portfolio)[,1]
targetReturn = getTargetReturn(frontier@portfolio)[,1]
ans = cbind(Risk = targetRisk, Return = targetReturn)

    colnames(ans) = c("targetRisk", "targetReturn")
    rownames(ans) = as.character(1:NROW(ans))


#points(ans)
plot(ans,xlim=c(min(ans[,1]),max(ans[,1])+.025),ylim=c(0,0.016),type="l",lwd=2, xlab=NA,ylab=NA)
#frontierPlot(frontier, pch=19,title=FALSE,xlim=c(min(ans[,1]),max(ans[,1])+.025),ylim=c(0,0.016),add=FALSE)
minvariancePoints(frontier,pch=19,col="red")
tangencyPoints(frontier,pch=19,col="blue")
#tangencyLines(frontier,pch=19,col="blue")
equalWeightsPoints(frontier,pch=15,col="grey")
singleAssetPoints(frontier,pch=19,cex=1.5,col=mycolors)
#twoAssetsLines(frontier,lty=3,col="grey")
#sharpeRatioLines(frontier,col="orange",lwd=2)
#legend("topleft",legend=colnames(portfolio.xts),pch=19,col=mycolors,
#	cex=0.65)

#label assets
stats <- getStatistics(frontier)
text(y=stats$mean,x=sqrt(diag(stats$Cov)),labels=names(stats$mean),pos=4,col=mycolors,cex=0.7)
#title(main="Efficient Frontier Small and Mid Since 1984")

#set up function from equalWeightsPoints to also label the point
equalLabel <- function (object, return = c("mean", "mu"), risk = c("Cov", "Sigma", 
    "CVaR", "VaR"), auto = TRUE, ...) 
{
    return = match.arg(return)
    risk = match.arg(risk)
    data = getSeries(object)
    spec = getSpec(object)
    constraints = getConstraints(object)
    numberOfAssets = getNAssets(object)
    setWeights(spec) = rep(1/numberOfAssets, times = numberOfAssets)
    ewPortfolio = feasiblePortfolio(data, spec, constraints)
    assets = frontierPoints(ewPortfolio, return = return, risk = risk, 
        auto = auto)
    text(assets, labels = "Equal-Weight", pos=4,...)
    invisible(assets)
}
equalLabel(frontier,cex=0.7,col="grey")
#title(main="Efficient Frontier 2000-October 2011",xlab="Risk(cov)",ylab="Monthly Return")

frontier <- portfolioFrontier(as.timeSeries(portfolio.xts["1950::1999"]))

pointsFrontier = frontierPoints(frontier, frontier = "both", auto=TRUE)
targetRisk = getTargetRisk(frontier@portfolio)[,1]
targetReturn = getTargetReturn(frontier@portfolio)[,1]
ans = cbind(Risk = targetRisk, Return = targetReturn)

    colnames(ans) = c("targetRisk", "targetReturn")
    rownames(ans) = as.character(1:NROW(ans))


points(ans,type="l",lwd=2,col="grey70")
singleAssetPoints(frontier,pch=19,cex=1.5,col=mycolors)
#label assets
stats <- getStatistics(frontier)
text(y=stats$mean,x=sqrt(diag(stats$Cov)),labels=names(stats$mean),pos=4,col=mycolors,cex=0.7)
#set up function from equalWeightsPoints to also label the point

equalWeightsPoints(frontier,pch=15,col="grey")
equalLabel(frontier,cex=0.7,col="grey")


legend("topleft",legend=c("1980 to 1999","2000 to 2011"),lwd=2,col=c("grey70","black"),cex=0.8,bty="n",horiz=TRUE)

title(main="A Tale of Two Frontiers",xlab="Risk(cov)",ylab="Monthly Return")





#############################use ivfrontier
#############################get frontiers by 5-year range
#from = time(as.timeSeries(portfolio.xts))[c(1,1,49,109,169,229,289,349,385)]
#to = time(as.timeSeries(portfolio.xts))[c(NROW(portfolio.xts),48,108,168,228,288,348,NROW(portfolio.xts)-8,NROW(portfolio.xts)-8)]


   Spec = portfolioSpec()
#   setTargetReturn(Spec) = mean(colMeans(as.timeSeries(portfolio.xts)))
#   setTargetReturn(Spec) = max(colMeans(as.timeSeries(portfolio.xts)))
   setTargetReturn(Spec) = 0
   Spec
   
## constraints -
   Constraints = "LongOnly"
   Constraints

from <- rollingWindows(as.timeSeries(portfolio.xts["1980::",]),period="120m",by="120m")$from
to <- rollingWindows(as.timeSeries(portfolio.xts["1980::",]),period="120m",by="120m")$to


rollFron <- rollingPortfolioFrontier(as.timeSeries(portfolio.xts["1980::",]),Spec,Constraints,
	from=from,to=to)

#chartcol <- topo.mycolors(length(rollFron))
chartcol <- 1:length(rollFron)


i=1
frontierPlot(rollFron[[1]],col=c(rep(chartcol[1],2)),xlim=c(0,0.12),ylim=c(-0.01,0.04))
frontierlabels <- frontierPoints(rollFron[[i]])
text(x=frontierlabels[NROW(frontierlabels),1],y=frontierlabels[NROW(frontierlabels),2],
	labels=paste(from[i]," to ",to[i],sep=""),
	pos=4,offset=0.5,cex=0.5,col = chartcol[i])

for (i in 2:(length(rollFron)) ) {
	frontierPlot(rollFron[[i]],add=TRUE,col = c(rep(chartcol[i],2)),pch=19,auto=FALSE,
		title=FALSE)
	frontierlabels <- frontierPoints(rollFron[[i]])
	text(x=frontierlabels[NROW(frontierlabels),1],y=frontierlabels[NROW(frontierlabels),2],
		labels=paste(from[i]," to ",to[i],sep=""),
		pos=4,offset=0.5,cex=0.5,col = chartcol[i])
}

#dev.off()

#draw line for expected bond return
#abline(h=0.025/12,col="indianred3")


#get annualized returns, stdev, and Sharpe for the indexes
ret.table <- as.data.frame(t(table.AnnualizedReturns(portfolio.xts)))
colnames(ret.table) <- c("Return","StdDev","Sharpe")
#sort by Sharpe ratio
ret.table <- ret.table[order(ret.table$Sharpe),]

par(mfrow=c(3,1)) # 3 rows and 1 column
for (i in 1:3) {
if (i==1) {
	par(mar=c(4,4,8,4))
	barplot(ret.table[,i],beside=TRUE,col=mycolors,
		names.arg=rownames(ret.table),cex.names=0.75,xlab=colnames(ret.table)[i])
	title(main="Return, Risk, and Sharpe since 1980",cex.main=2)
}
else{
	par(mar=c(4,4,4,4))
	barplot(ret.table[,i],beside=TRUE,col=mycolors,
		names.arg=rownames(ret.table),cex.names=0.75,xlab=colnames(ret.table)[i])
}
}

#use ggplot for an alternative visualization
ret.table.melt <- melt(cbind(rownames(ret.table),ret.table))
colnames(ret.table.melt) <- c("Index","Statistic","Value")

ggplot(ret.table.melt, stat="identity", aes(x=Statistic,y=Value,fill=Index)) +
 	geom_bar(position="dodge") +
	scale_fill_manual(values=mycolors) +
	theme_bw() +
	opts(title = "Return, Risk, and Sharpe", plot.title = theme_text(size = 20, hjust=0))




#explore correlation
#chart.Correlation(portfolio.xts["1950::1999"])
#chart.Correlation(portfolio.xts["2000::"])

#get correlation to S&P 500 ([6]) by different periods
corr <- rbind(cor(portfolio.xts["1950::1999"])[,6],
	cor(portfolio.xts["2000::2006"])[,6],
	cor(portfolio.xts["2007::"])[,6])
rownames(corr) <- c("1979-1999","2000-2006","2007-now")
#melt the results to work well with graphics
corr.melt <- melt(corr[,1:5])
colnames(corr.melt) <- c("period","index","correlation")

#set factors to allow grouping for graphics
corr.melt[,1] <- factor(corr.melt[,1])
corr.melt[,2] <- factor(corr.melt[,2])

#first attempts to visualize
#abandoned refinement pretty quickly in favor of ggplot
#dotchart(x=corr.melt$correlation,labels=corr.melt$period,group=corr.melt$index)
#stripchart(corr.melt$correlation~corr.melt$index*corr.melt$period,vertical=TRUE,col=c(1:3))
#stripchart(corr.melt$correlation~corr.melt$period,vertical=TRUE,col=c(1:3),pch=19)

#use ggplot to achieve best result (my opinion)
ggplot(corr.melt, stat="identity", aes(x=period,y=correlation,group=index,colour=index)) +
 	geom_point() + geom_line() +
	scale_colour_manual(values=mycolors) +
	theme_bw() +
	opts(title = "Correlation to the S&P 500 by Period", plot.title = theme_text(size = 20, hjust=0)) +
	opts(legend.position = "none") +
	geom_text(data = corr.melt[corr.melt$period == "2007-now",],
		aes(label = index),size=3 , hjust = -0.05, vjust = 0)