|
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) |
This is excellent! Thanks for sharing!
ReplyDeleteAre you unable to share the data because it has the Barclay's index? Would you be able to create this with the US 10 Yr as a proxy instead so that the post is completely reproducible?