A Tale of Two Frontiers
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.
In a follow up to Evolving Domestic Frontier, I wanted to explore the efficient frontier including international indexes since 1980. Life is great when your primary indexes (Barclays Aggregate and S&P 500) lie on the frontier as they did 1980-1999. The situation becomes much more difficult with a frontier like 2000-now.
![]() |
From TimelyPortfolio |
If we examine return, risk, and Sharpe though, 1980 to now was really not that bad with annualized returns of all indexes stocks and bonds > 8% even including the last decade of “equity misery”. As the S&P 500 shifted from the top of the efficient frontier to the bottom, it seems the focus over the last decade as been finding alternatives for the S&P 500. Strangely, the unbelievable riskless return of bonds has allowed some investors to claim and use bonds as one of these potential alternatives to the S&P 500.
![]() |
From TimelyPortfolio |
![]() |
From TimelyPortfolio |
Bonds as alternatives to equities have made even more sense when we look at correlations.
![]() |
From TimelyPortfolio |
However, bonds based on the yield to maturity of the Barclays Aggregate index suggest, even guarantee, forward returns of only 2.3%, significantly below the +8% generously provided for 30 years. I believe the focus on alternatives should be alternatives for the guaranteed miserably low returns of bonds (WSJ Bond Buyers Dilemma). The trick though is reducing risk (drawdown) of these alternatives to an acceptable level to most bond investors. Max drawdown on bonds since 1982 has been 5%, which is virtually an impossible constraint for any risky alternatives, since in even very attractive secular buy-hold periods, drawdown generally is 20% to 30%.
![]() |
From TimelyPortfolio |
Our options are basically limited to cash, which at 0% return is unacceptable, unless we can discover a method to reduce drawdown on the risky set of alternatives to 20%, but really down to 10%. How do we transform risky alternatives with historical drawdowns of 40%-70% to an acceptable bond alternative? I think it requires tactical techniques blended with cash with a lot of client education and hand-holding.
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) |
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.