|
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) |