Create a gist now

Instantly share code, notes, and snippets.

Tale of Two Frontiers
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