A Tale of Two Frontiers

[This article was first published on Timely Portfolio, and kindly contributed to R-bloggers]. (You can report issue about the content on this page here)
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.

R code from GIST:

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)
view raw taleoftwo.r hosted with ❤ by GitHub

To leave a comment for the author, please follow the link and comment on their blog: Timely Portfolio.

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.

Never miss an update!
Subscribe to R-bloggers to receive
e-mails with the latest R posts.
(You will not see this message again.)

Click here to close (This popup will not appear again)