[Returnanalytics-commits] r3249 - pkg/PortfolioAnalytics/sandbox/symposium2013

Mon Nov 11 00:12:54 CET 2013

Author: peter_carl
Date: 2013-11-11 00:12:52 +0100 (Mon, 11 Nov 2013)
New Revision: 3249

Modified:
   pkg/PortfolioAnalytics/sandbox/symposium2013/optimize.HFindexes.R
   pkg/PortfolioAnalytics/sandbox/symposium2013/results.HFindexes.R
Log:
- code cleanup for final slides

Modified: pkg/PortfolioAnalytics/sandbox/symposium2013/optimize.HFindexes.R
===================================================================

--- pkg/PortfolioAnalytics/sandbox/symposium2013/optimize.HFindexes.R	2013-11-08 15:08:47 UTC (rev 3248)
+++ pkg/PortfolioAnalytics/sandbox/symposium2013/optimize.HFindexes.R	2013-11-10 23:12:52 UTC (rev 3249)
@@ -481,6 +481,7 @@
 # Calculate the objective measures for the vol weight portfolio
 VolWgt.opt <- volatility.weight(R=R, portfolio=VolWgt.portf)
 
+
 # REMOVED
 # ### Evaluate Constrained Concentration to mETL Portfolio - with DE
 # # registerDoSEQ() # turn off parallelization to keep the trace data
@@ -578,11 +579,19 @@
 EqWgt.R=Return.rebalancing(R, EqWgt.w)
 chart.StackedBar(EqWgt.w, colorset=wb13color, gap=0)
 
+VolWgt.w = NULL
+for(i in 3:length(dates)){
+  x = volatility.weight(R=R[paste0("::",dates[i]),], portfolio=VolWgt.portf)
+  VolWgt.w = rbind(VolWgt.w, x$weights)
+}
+VolWgt.w = as.xts(VolWgt.w, order.by=dates[-1:-2])
+VolWgt.R=Return.rebalancing(R, VolWgt.w)
+
 # Equal SD
 MRCSD.DE.t = optimize.portfolio.rebalancing(R=R,
   portfolio=MRCSD.portf, 
   optimize_method='DEoptim',
-  search_size=20000,
+  search_size=2000,
   NP=200,
   initialpop=rp[1:50,], # seed with a starting population that we know fits the constraint space
   trace=FALSE,

Modified: pkg/PortfolioAnalytics/sandbox/symposium2013/results.HFindexes.R
===================================================================
--- pkg/PortfolioAnalytics/sandbox/symposium2013/results.HFindexes.R	2013-11-08 15:08:47 UTC (rev 3248)
+++ pkg/PortfolioAnalytics/sandbox/symposium2013/results.HFindexes.R	2013-11-10 23:12:52 UTC (rev 3249)
@@ -192,140 +192,9 @@
 dev.off()
 
 # --------------------------------------------------------------------
-# Plot efficient frontier of mean-sd?
-# --------------------------------------------------------------------
-
-
-# --------------------------------------------------------------------
-# Plot efficient frontier of mean-mETL?
-# --------------------------------------------------------------------
-
-
-# --------------------------------------------------------------------
-# Plot efficient frontier of Equal Risk
-# --------------------------------------------------------------------
-
-
-# --------------------------------------------------------------------
-# Plot Ex Post scatter of buoy portfolios?
-# --------------------------------------------------------------------
-# No.
-# 
-# # Calculate ex post results
-# xpost.ret=Return.cumulative(BHportfs["2008-07::2008-09"])
-# xpost.sd=StdDev(BHportfs["2008-07::2008-09"])*sqrt(3)
-# xante.ret=xtract[,"pamean.pamean"]/3
-# xante.sd=xtract[,"pasd.pasd"]/sqrt(3)
-# 
-# xpost.obj=NA
-# for(i in 1:NROW(RND.weights)){
-#   x = Return.portfolio(R=edhec.R["2008-07::2008-09"], weights=RND.weights[i,])
-#   y=c(Return.cumulative(x), StdDev(x)*sqrt(3))
-#   if(is.na(xpost.obj))
-#     xpost.obj=y
-#   else
-#     xpost.obj=rbind(xpost.obj,y)
-# }
-# rownames(xpost.obj)=rownames(RND.weights)
-# colnames(xpost.obj)=c("Realized Returns","Realized SD")
-# xmin=min(c(xpost.sd,xante.sd))
-# xmax=max(c(xpost.sd,xante.sd))
-# ymin=min(c(xpost.ret,xante.ret))
-# ymax=max(c(xpost.ret,xante.ret))
-# 
-# CairoPDF(file=paste(resultsdir, dataname, "-Scatter-ExPost-2008-06-30.png", units="in", height=5.5, width=9, res=96)
-# par(mar=c(5, 5, 1, 2) + 0.1) #c(bottom, left, top, right)
-# plot(xpost.sd,xpost.ret, xlab="StdDev", ylab="Mean", col="darkgray", axes=FALSE, main="", cex=.6,  xlim=c(xmin,xmax), ylim=c(ymin,ymax))
-# grid(col = "darkgray")
-# points(xpost.obj[,2],xpost.obj[,1], col=tol7qualitative, pch=16, cex=1.5)
-# points(xante.sd,xante.ret, col="lightgray", cex=.7)
-# points(unlist(RND.objectives[,2])/sqrt(3),unlist(RND.objectives[,1])/3, col=tol7qualitative, pch=16, cex=1.5)
-# abline(h = 0, col = "darkgray")
-# axis(1, cex.axis = 0.7, col = "darkgray")
-# axis(2, cex.axis = 0.7, col = "darkgray")
-# box(col = "darkgray")
-# legend("topright",legend=rownames(RND.weights), col=tol7qualitative, pch=16, ncol=1,  border.col="darkgray", y.intersp=1.2, inset=.02)
-# dev.off()
-
-
-
-# --------------------------------------------------------------------
-# Ex Post Results Through Time?
-# --------------------------------------------------------------------
-# @TODO: revise for this result set
-buoys.R=cbind(EqWgt,MeanSD, MeanmETL,MinSD,MinmETL,MRCSD,EqmETL)
-CairoPDF(file=paste(resultsdir, dataname, "-Buoy-Cumulative-Returns.png", units="in", height=5.5, width=9, res=96) 
-op <- par(no.readonly = TRUE)
-layout(matrix(c(1, 2)), height = c(2, 1.3), width = 1)
-par(mar = c(1, 5, 1, 2)) # c(bottom, left, top, right)
-chart.CumReturns(buoys.R["2000::",], main = "", xaxis = FALSE, legend.loc = "topleft", ylab = "Cumulative Return", colorset= tol7qualitative, ylog=TRUE, wealth.index=TRUE, cex.legend=.7, cex.axis=.6, cex.lab=.7)
-par(mar = c(4, 5, 0, 2))
-chart.Drawdown(buoys.R["2000::",], main = "", ylab = "Drawdown", colorset = tol7qualitative, cex.axis=.6, cex.lab=.7)
-par(op)
-dev.off()
-
-
-### APPENDIX SLIDES:
-
-# --------------------------------------------------------------------
-# Show turnover of the RP portfolios relative to the EqWgt portfolio
-# --------------------------------------------------------------------
-turnover = function(w1,w2) {sum(abs(w1-w2))/length(w1)}
-# Calculate the turnover matrix for the random portfolio set:
-to.matrix<-matrix(nrow=NROW(rp),ncol=NROW(rp))
-for(x in 1:NROW(rp)){
-  for(y in 1:NROW(rp)) {
-    to.matrix[x,y]<-turnover(rp[x,],rp[y,])
-  }
-}
-
-CairoPDF(file=paste(resultsdir, dataname, "-Turnover-2008-06-30.pdf", sep=""), height=5.5, width=9) 
-# postscript(file="TurnoverOf20101231.eps", height=5.5, width=5, paper="special", horizontal=FALSE, onefile=FALSE)
-op <- par(no.readonly=TRUE)
-layout(matrix(c(1,2)),height=c(4,1.25),width=1)
-par(mar=c(5,4,1,2)+.1, cex=1) # c(bottom, left, top, right)
-seq.col = heat.colors(11)
-## Draw the Scatter chart of combined results
-### Get the random portfolios from one of the result sets
-x=apply(rp, MARGIN=1,FUN=turnover,w2=rp[1,])
-plot(xtract[,"pasd.pasd"],xtract[,"pamean.pamean"], xlab="Predicted StdDev", ylab="Predicted Mean", col=seq.col[ceiling(x*100)], axes=FALSE, main="", cex=.6, pch=16)
-grid(col = "darkgray")
-points(RND.objectives[1,2],RND.objectives[1,1], col="blue", pch=19, cex=1.5)
-axis(1, cex.axis = 0.7, col = "darkgray")
-axis(2, cex.axis = 0.7, col = "darkgray")
-box(col = "darkgray")
-
-# Add legend to bottom panel
-par(mar=c(5,5.5,1,3)+.1, cex=0.7)
-## Create a histogramed legend for sequential colorsets
-## this next bit of code is based on heatmap.2 in gplots package
-x=ceiling(x*100)
-scale01 <- function(x, low = min(x), high = max(x)) {
-  return((x - low)/(high - low))
-}
-breaks <- seq(min(x, na.rm = TRUE), max(x, na.rm = TRUE), length = length(seq.col)+1)
-min.raw <- min(x, na.rm = TRUE)
-max.raw <- max(x, na.rm = TRUE)
-z <- seq(min.raw, max.raw, length = length(seq.col))
-image(z = matrix(z, ncol = 1), col = seq.col, breaks = breaks, xaxt = "n", yaxt = "n")
-par(usr = c(0, 1, 0, 1)) # needed to draw the histogram correctly
-lv <- pretty(breaks)
-xv <- scale01(as.numeric(lv), min.raw, max.raw)
-axis(1, at = xv, labels=sprintf("%s%%", pretty(lv)))
-h <- hist(x, plot = FALSE, breaks=breaks)
-hx <- scale01(breaks, min(x), max(x))
-hy <- c(h$counts, h$counts[length(h$counts)])
-lines(hx, hy/max(hy)*.95, lwd = 2, type = "s", col = "blue")
-axis(2, at = pretty(hy)/max(hy)*.95, pretty(hy))
-title(ylab="Count")
-title(xlab="Degree of Turnover from Equal Weight Portfolio")
-par(op)
-dev.off()
-
-# --------------------------------------------------------------------
 # Show CONCENTRATION of the RP portfolios
 # --------------------------------------------------------------------
-# Basically the same chart as above but use HHI instead of turnover calc
+# Use HHI
 
 CairoPDF(file=paste(resultsdir, dataname, "-ConcPercESContrib.pdf", sep=""), height=5.5, width=9) 
 WB20 = c(colorpanel(1, "#008566","#E1E56D"), colorpanel(20, "#E1E56D", "#742414")[-1])
@@ -523,19 +392,105 @@
 par(op)
 dev.off()
 
+  
+### APPENDIX SLIDES:
+  
 # --------------------------------------------------------------------
-# Show weights through time for EqmETL portfolio
+# Show weights through time for MRC SD portfolio
 # --------------------------------------------------------------------
-EqmETL.w = extractWeights(EqmETL.DE.t)
-chart.UnStackedBar(EqmETL.w, rotate="horizontal", colorset=wb13color, space=0, las=2)
+print(load("results/MRCSD.DE.t-2013-10-17-historical.moments.rda"))
+MRCSD.w = extractWeights(MRCSD.DE.t)
+CairoPDF(file=paste(resultsdir, dataname, "-weights-SD.pdf", sep=""), height=5.5, width=9)
+chart.UnStackedBar(MRCSD.w, rotate="horizontal", colorset=wb13color, space=0, las=3, cex.axis=0.7, cex.names=0.8)
+dev.off()
 
 # --------------------------------------------------------------------
+# Show percent contribution of MRC SD through time
+# --------------------------------------------------------------------
+# Extract perc contrib of mES from results object
+x=NULL
+for(i in 1:length(names(MRCSD.DE.t)))  {
+  x = rbind(x,MRCSD.DE.t[[i]][["objective_measures"]]$StdDev$pct_contrib_StdDev)
+}
+x.xts = as.xts(x, order.by=as.POSIXct(names(MRCSD.DE.t)))
+  colnames(x.xts)=names(MRCmETL.DE.t[[1]][["objective_measures"]]$StdDev$pct_contrib_StdDev)
+CairoPDF(file=paste(resultsdir, dataname, "-contribution-SD.pdf", sep=""), height=5.5, width=9)
+chart.UnStackedBar(x.xts, rotate="horizontal", colorset=wb13color, space=0, las=3, cex.axis=0.7, cex.names=0.8)
+dev.off()
+  
+# --------------------------------------------------------------------
+# Show weights through time for MRC mETL portfolio
+# --------------------------------------------------------------------
+print(load("results/MRCmETL.DE.t-2013-10-18-historical.moments.rda"))
+MRCmETL.w = extractWeights(MRCmETL.DE.t)
+CairoPDF(file=paste(resultsdir, dataname, "-weights-mETL.pdf", sep=""), height=5.5, width=9)
+chart.UnStackedBar(MRCmETL.w, rotate="horizontal", colorset=wb13color, space=0, las=3, cex.axis=0.7, cex.names=0.8)
+dev.off()
+
+# --------------------------------------------------------------------
 # Show percent contribution of mETL through time
 # --------------------------------------------------------------------
 # Extract perc contrib of mES from results object
 x=NULL
-for(i in 1:length(names(EqmETL.RND.t)))  {
-  x = rbind(x,EqmETL.RND.t[[i]][["objective_measures"]]$ES$pct_contrib_MES)
+for(i in 1:length(names(MRCmETL.DE.t)))  {
+  x = rbind(x,MRCmETL.DE.t[[i]][["objective_measures"]]$ES$pct_contrib_MES)
 }
-x.xts = as.xts(x, order.by=as.POSIXct(names(EqmETL.RND.t)))
-chart.UnStackedBar(x.xts, rotate="horizontal", colorset=wb13color, space=0, las=2)
+x.xts = as.xts(x, order.by=as.POSIXct(names(MRCmETL.DE.t)))
+colnames(x.xts)=names(MRCmETL.DE.t[[1]][["objective_measures"]]$ES$pct_contrib_MES)
+CairoPDF(file=paste(resultsdir, dataname, "-contribution-mETL.pdf", sep=""), height=5.5, width=9)
+chart.UnStackedBar(x.xts, rotate="horizontal", colorset=wb13color, space=0, las=3, cex.axis=0.7, cex.names=0.8)
+dev.off()
+  
+# --------------------------------------------------------------------
+# Show out-of-sample performance of buoy portfolios
+# --------------------------------------------------------------------
+  EqWgt.opt$weights
+dates=index(R[endpoints(R, on="years")])
+EqWgt.w = xts(matrix(rep(1/NCOL(R),length(dates)*NCOL(R)), ncol=NCOL(R)), order.by=dates)
+EqWgt.R = Return.rebalancing(R, EqWgt.w)
+MRCSD.R = Return.rebalancing(R, MRCSD.w)  
+MRCmETL.R = Return.rebalancing(R, MRCmETL.w)
+x.R = cbind(EqWgt.R, VolWgt.R, MRCSD.R, MRCmETL.R)
+colnames(x.R)=c("Eq Wgt", "Vol Wgt", "MRC SD", "MRC mETL")
+CairoPDF(file=paste(resultsdir, dataname, "-OOS-relative-performance.pdf", sep=""), height=5.5, width=9)
+chart.RelativePerformance(x.R["2000::",2:4], x.R["2000::",1], colorset=wb13color[c(8,7,11)], lwd=3, legend.loc="bottomleft", main="Performance Relative to Equal Weight")
+dev.off()
+
+table.RiskStats(x.R["2000::"], p=1-1/12)
+  
+R.boudt=Return.clean(R, method="boudt")
+# --------------------------------------------------------------------
+# From Inception Mean of constituents
+# --------------------------------------------------------------------
+x.mean=apply.fromstart(R,FUN="mean")
+x.mean=as.xts(x.mean)
+CairoPDF(file=paste(resultsdir, dataname, "-from-inception-mean.pdf", sep=""), height=5.5, width=9)
+chart.TimeSeries(x.mean["2000-01::",],legend.loc="topright", colorset=wb13color, pch="", lwd=3, main="From-Inception Mean")
+dev.off()
+
+# --------------------------------------------------------------------
+# From Inception Volatility of constituents
+# --------------------------------------------------------------------
+x.vol=apply.fromstart(R,FUN="StdDev")
+x.vol=as.xts(x.vol)
+CairoPDF(file=paste(resultsdir, dataname, "-from-inception-vol.pdf", sep=""), height=5.5, width=9)
+chart.TimeSeries(x.vol["2000-01::",],legend.loc="bottomleft", colorset=wb13color, pch="", lwd=3, main="From-Inception Volatility")
+dev.off()
+  
+# --------------------------------------------------------------------
+# From Inception Skewness of constituents
+# --------------------------------------------------------------------
+x.skew=apply.fromstart(R,FUN="skewness")
+x.skew=as.xts(x.skew)
+CairoPDF(file=paste(resultsdir, dataname, "-from-inception-skew.pdf", sep=""), height=5.5, width=9)
+chart.TimeSeries(x.skew["2000-01::",],legend.loc="bottomleft", colorset=wb13color, pch="", lwd=3, main="From-Inception Skewness")
+dev.off()
+  
+# --------------------------------------------------------------------
+# From Inception Kurtosis of constituents
+# --------------------------------------------------------------------
+x.kurt=apply.fromstart(R,FUN="kurtosis")
+x.kurt=as.xts(x.kurt)
+CairoPDF(file=paste(resultsdir, dataname, "-from-inception-kurt.pdf", sep=""), height=5.5, width=9)
+chart.TimeSeries(x.kurt["2000-01::",],legend.loc="topleft", colorset=wb13color, pch="", lwd=3, main="From-Inception Kurtosis")
+dev.off()
\ No newline at end of file

