Created
December 9, 2011 17:19
Tale of Two Frontiers
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) | |
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) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment