CoCalc -- results.HFindexes.R

GitHub Repository: braverock/portfolioanalytics
Path: blob/master/sandbox/symposium2013/results.HFindexes.R
¹⁴³³ views
1
# Presentation of results from optimization scripts run prior to this script
2

3
op <- par(no.readonly=TRUE)
4

5
# --------------------------------------------------------------------
6
# Plot Ex Ante scatter of RP and ONLY Equal Weight portfolio in StdDev space
7
# --------------------------------------------------------------------
8
# Done
9
CairoPDF(file=paste(resultsdir, dataname, "-RP-EqWgt-MeanSD-ExAnte.pdf", sep=""), height=5.5, width=9)  
10
par(mar=c(5, 4, 1, 1) + 0.1) #c(bottom, left, top, right)
11
# Calculate chart bounds to unify with the charts below
12
xlim.StdDev=c(min(c(xtract[,"StdDev"], buoys.portfmeas[,"StdDev"])), max(c(xtract[,"StdDev"], buoys.portfmeas[,"StdDev"])))
13
ylim.mean=c(min(c(xtract[,"mean"], buoys.portfmeas[,"Mean"])), max(c(xtract[,"mean"], buoys.portfmeas[,"Mean"])))
14

15
plot(xtract[,"StdDev"],xtract[,"mean"], xlab="Ex Ante Std Dev", ylab="Ex Ante Mean", col="darkgray", axes=FALSE, main="", cex=.6, xlim=xlim.StdDev, ylim=ylim.mean) # leave cloud darkgray for this slide
16
grid(col = "darkgray")
17
abline(h = 0, col = "darkgray")
18
# Overplot the equal weight portfolio
19
points(buoys.portfmeas[8,"StdDev"],buoys.portfmeas[8,"Mean"], col=wb13color[4], pch=16, cex=1.5) # watch the order in portfmeas
20
axis(1, cex.axis = 0.8, col = "darkgray")
21
axis(2, cex.axis = 0.8, col = "darkgray")
22
box(col = "darkgray")
23
legend("bottomright",legend=results.names[8], col=wb13color[4], pch=16, ncol=1,  border.col="darkgray", y.intersp=1.2, cex=0.8, inset=.02)
24
par(op)
25
dev.off()
26

27
# --------------------------------------------------------------------
28
# Plot Ex Ante scatter of RP and ASSET portfolios in StdDev space
29
# --------------------------------------------------------------------
30
# @TODO: add the assets to this chart
31
CairoPDF(file=paste(resultsdir, dataname, "-RP-Assets-MeanSD-ExAnte.pdf", sep=""), height=5.5, width=9)  
32
xlim.StdDev.assets =c(min(c(xtract[,"StdDev"], assets.portfmeas[,"StdDev"], 0)), max(c(xtract[,"StdDev"], assets.portfmeas[,"StdDev"],0.03)))
33
ylim.mean.assets =c(min(c(xtract[,"mean"], assets.portfmeas[,"Mean"], 0)), max(c(xtract[,"mean"], assets.portfmeas[,"Mean"])))
34
par(mar=c(5, 4, 1, 1) + 0.1) #c(bottom, left, top, right)
35
# Revise the chart bounds to include the asssets
36
plot(xtract[,"StdDev"],xtract[,"mean"], xlab="Ex Ante mETL", ylab="Ex Ante Mean", col="darkgray", axes=FALSE, main="", cex=.3, xlim=xlim.StdDev.assets, ylim=ylim.mean.assets)
37
grid(col = "darkgray")
38
abline(h = 0, col = "darkgray")
39
abline(v = 0, col = "darkgray")
40
# Overplot the equal weight portfolio
41
points(buoys.portfmeas[8,"StdDev"],buoys.portfmeas[8,"Mean"], col=wb13color[4], pch=16, cex=1.5) # watch the order in portfmeas
42
text(x=buoys.portfmeas[8,"StdDev"], y=buoys.portfmeas[8,"Mean"], labels=rownames(buoys.portfmeas)[8], pos=4, cex=1)
43
points(assets.portfmeas[,"StdDev"],assets.portfmeas[,"Mean"], col=rich8equal, pch=18, cex=1.5) # watch the order in portfmeas
44
text(x=assets.portfmeas[,"StdDev"], y=assets.portfmeas[,"Mean"], labels=rownames(assets.portfmeas), pos=4, cex=1)
45
axis(1, cex.axis = 0.7, col = "darkgray")
46
axis(2, cex.axis = 0.7, col = "darkgray")
47
box(col = "darkgray")
48
#legend("right",legend=rownames(assets.portfmeas), col=rich8equal, pch=16, ncol=1,  border.col="darkgray", y.intersp=1.2, cex=0.8, inset=.02)
49
par(op)
50
dev.off()
51

52
# --------------------------------------------------------------------
53
# Plot Ex Ante scatter of RP and BUOY portfolios in StdDev space
54
# --------------------------------------------------------------------
55
# Done
56
CairoPDF(file=paste(resultsdir, dataname, "-RP-BUOY-MeanSD-ExAnte.pdf", sep=""), height=5.5, width=9)  
57
par(mar=c(5, 4, 1, 1) + 0.1) #c(bottom, left, top, right)
58
plot(xtract[,"StdDev"],xtract[,"mean"], xlab="Ex Ante Std Dev", ylab="Ex Ante Mean", col="gray", axes=FALSE, main="", cex=.6, xlim=xlim.StdDev, ylim=ylim.mean, cex.lab=1)
59
grid(col = "darkgray")
60
abline(h = 0, col = "darkgray")
61
# Overplot the buoy portfolios
62
points(buoys.portfmeas[,"StdDev"],buoys.portfmeas[,"Mean"], col=wb13color[c(3,9,13,6,7,11,8,4)], pch=16, cex=1.5) # watch the order in portfmeas
63
axis(1, cex.axis = 0.6, col = "darkgray")
64
axis(2, cex.axis = 0.6, col = "darkgray")
65
box(col = "darkgray")
66
legend("bottomright",legend=results.names, col=wb13color[c(3,9,13,6,7,11,8,4)], pch=16, ncol=1,  border.col="darkgray", y.intersp=1.2, cex=0.8, inset=.02)
67
par(op)
68
dev.off()
69

70
# --------------------------------------------------------------------
71
# Plot Ex Ante scatter of RP and BUOY portfolios in mETL space
72
# --------------------------------------------------------------------
73
# Done
74
CairoPDF(file=paste(resultsdir, dataname, "-RP-BUOYS-mETL-ExAnte.pdf", sep=""), height=5.5, width=9)  
75
par(mar=c(5, 4, 1, 1) + 0.1) #c(bottom, left, top, right)
76
xlim.ES=c(min(c(xtract[,"ES"], buoys.portfmeas[,"mETL"])), max(c(xtract[,"ES"], buoys.portfmeas[,"mETL"])))
77
plot(xtract[,"ES"],xtract[,"mean"], xlab="Ex Ante mETL", ylab="Ex Ante Mean", col="gray", axes=FALSE, main="", cex=.6, xlim=xlim.ES, ylim=ylim.mean, cex.lab=1)
78
grid(col = "darkgray")
79
# Overplot the buoy portfolios
80
points(buoys.portfmeas[,"mETL"],buoys.portfmeas[,"Mean"], col=wb13color[c(3,9,13,6,7,11,8,4)], pch=16, cex=1.5) # watch the order in portfmeas
81
axis(1, cex.axis = 0.6, col = "darkgray")
82
axis(2, cex.axis = 0.6, col = "darkgray")
83
box(col = "darkgray")
84
legend("bottomright",legend=results.names, col=wb13color[c(3,9,13,6,7,11,8,4)], pch=16, ncol=1,  border.col="darkgray", y.intersp=1.2, cex=0.8, inset=.02)
85
par(op)
86
dev.off()
87

88
# --------------------------------------------------------------------
89
# Plot weights of Buoy portfolios
90
# --------------------------------------------------------------------
91
# Done
92
source('./R/chart.UnStackedBar.R')
93
# Wgts = extractWeights(buoys)
94
CairoPDF(file=paste(resultsdir, dataname, "-Weights-Buoys.png", sep=""), height=5.5, width=9)
95
chart.UnStackedBar(t(Wgts), colorset=wb13color[c(3,9,13,6,7,11,8,4)], equal.line=TRUE)
96
dev.off()
97

98
# --------------------------------------------------------------------
99
# Plot contribution to risk of Buoy portfolios
100
# --------------------------------------------------------------------
101
# @TODO: revise for this result set
102
# @TODO: add contribution to risk to portfmeas
103
source('./R/chart.UnStackedBar.R')
104
CairoPDF(file=paste(resultsdir, dataname, "-mETL-Perc-Contrib-Buoys.pdf", sep=""), height=5.5, width=9) 
105
chart.UnStackedBar(t(buoys.perc.es), colorset=wb13color[c(3,9,13,6,7,11,8,4)], equal.line=TRUE)
106
dev.off()
107
# Alternatively, use table function for ES
108

109
# --------------------------------------------------------------------
110
# Plot cumulative contribution to risk of Buoy portfolios
111
# --------------------------------------------------------------------
112
cumRisk=NULL
113
for(i in 1:NROW(buoys.contrib.es)) {
114
  y = cumsum(buoys.contrib.es[i,order(buoys.contrib.es[i,], decreasing=TRUE)])
115
  cumRisk=rbind(cumRisk,y)
116
}
117
colnames(cumRisk)=c("Most",2:6,"Least")
118
rownames(cumRisk)= rownames(buoys.contrib.es)
119

120
CairoPDF(file=paste(resultsdir, dataname, "-mETL-CumulPerc-Contrib-Buoys.pdf", sep=""), height=5.5, width=9) 
121
par(mar=c(5, 4, 1, 4) + 0.1) #c(bottom, left, top, right)
122
plot(cumRisk[8,], ylim=c(0,max(cumRisk)), col=wb13color[8], type="l", lwd=2, axes=FALSE, main="", xlab="Rank of Contribution to Risk", ylab="Portfolio Risk")
123
grid(col = "darkgray")
124
abline(h = 0, col = "darkgray")
125
axis(1, cex.axis = 0.7, col = "darkgray")
126
axis(2, cex.axis = 0.7, col = "darkgray")
127
box(col = "darkgray")
128
for(i in 1:8) {
129
  lines(cumRisk[i,], col=wb13color[c(3,9,13,6,7,11,8,4)][i], lwd=3)
130
  # put the values of the rightmost dot on the plot; that's the portfolio risk 
131
  points(7, cumRisk[i,7], col = wb13color[c(3,9,13,6,7,11,8,4)][i], pch=20, cex=1)
132
	mtext(paste(round(100*cumRisk[i,7],2),"%", sep=""), line=.5, side = 4, at=cumRisk[i,7], adj=0, las=2, cex = 0.9, col = wb13color[c(3,9,13,6,7,11,8,4)][i])
133
}
134
# Add legend
135
legend("bottomright",legend=rownames(cumRisk), col=wb13color[c(3,9,13,6,7,11,8,4)], pch=16, ncol=1,  border.col="darkgray", y.intersp=1.2, cex=.9, lwd=3, inset=.02)
136
par(op)
137
dev.off()
138

139
# --------------------------------------------------------------------
140
# Scatter chart with DE trail
141
# --------------------------------------------------------------------
142
CairoPDF(file=paste(resultsdir, dataname, "-DE-MeanSD-ExAnte.pdf", sep=""), height=5.5, width=9)
143
# chart in same coordinates as RP; will leave some of the dots outside the chart bounds
144
chart.RiskReward(RiskBudget.DE, risk.col="StdDev", return.col="mean", xlim=xlim.StdDev, ylim=ylim.mean, las=1)
145
par(op)
146
dev.off()
147
# convert -density 300 DE-MeanSD-ExAnte.pdf -quality 100 -sharpen 0x1.0 ../docs/symposium-slides-2013-figure/DE-MeanSD-ExAnte.png
148

149
# --------------------------------------------------------------------
150
# Plot contribution of risk in EqWgt portfolio
151
# --------------------------------------------------------------------
152
CairoPDF(file=paste(resultsdir, dataname, "-Weights-Risk-Comparison.pdf", sep=""), height=5.5, width=9)
153
y=rbind(t(Wgts[8,]), t(buoys.perc.es[8,]), t(Wgts[6,]), t(buoys.perc.es[6,]))
154
rownames(y)=c("Weight","Risk", "Weight", "Risk")
155
# Break this into two charts
156
chart.UnStackedBar(y, rotate="horizontal", colorset=c(wb13color[4],wb13color[7]), las=1, density=c(-1,25,-1,25))
157
#chart.UnStackedBar(y, rotate="vertical", colorset=wb13color, equal.line=TRUE)
158
par(op)
159
dev.off()
160

161
# For equal ES contribution
162
colorset=c(wb13color[4],wb13color[4],wb13color[11],wb13color[11])
163
w=rbind(t(Wgts[8,]), t(buoys.perc.es[8,]), t(Wgts[6,]), t(buoys.perc.es[6,]))
164
rownames(w)=c("Weight","% of Risk", "Weight", "% of Risk")
165

166
# For equal Volatility contribution
167
colorset=c(wb13color[4],wb13color[4],wb13color[7],wb13color[7])
168
w=rbind(t(Wgts[8,]), t(buoys.perc.sd[8,]), t(Wgts[5,]), t(buoys.perc.sd[5,]))
169
rownames(w)=c("Weight","% of Volatility", "Weight", "% of Volatility")
170

171
# Chart either of the above data sets
172
CairoPDF(file=paste(resultsdir, dataname, "-Weights-Risk-Comparison.pdf", sep=""), height=5.5, width=9)
173
par(oma = c(2,4,4,1), mar=c(1,0,.5,1)) # c(bottom, left, top, right)
174
layout(matrix(c(1:(NCOL(w))), nr = NCOL(w), byrow = FALSE), height=c(rep(1/7,7)))
175
for(i in 1:NCOL(w)){
176
  if(i==NCOL(w)){
177
    barplot(w[,i], col=colorset, horiz=FALSE, ylim=c(0,max(w)), axes=FALSE, names.arg=rownames(w), cex.names=1.5, density=c(-1,25,-1,25))
178
    abline(h=0, col="darkgray")
179
    abline(h=1/7, col="darkgray", lty=2)
180
    axis(2, cex.axis = 0.7, col = "darkgray", las=1)
181
    mtext(colnames(w)[i], side= 3, cex=1, adj=0)
182
  } 
183
  else{
184
    barplot(w[,i], col=colorset, horiz=FALSE, ylim=c(0,max(w)), axes=FALSE, names.arg="", ylab=colnames(w)[i], las=1, density=c(-1,25,-1,25))
185
    abline(h=0, col="darkgray")
186
    abline(h=1/7, col="darkgray", lty=2)
187
    axis(2, cex.axis = 0.7, col = "darkgray", las=1)
188
    mtext(colnames(w)[i], side= 3, cex=1, adj=0)
189
  }
190
}
191
par(op)
192
dev.off()
193

194
# --------------------------------------------------------------------
195
# Show CONCENTRATION of the RP portfolios
196
# --------------------------------------------------------------------
197
# Use HHI
198

199
CairoPDF(file=paste(resultsdir, dataname, "-ConcPercESContrib.pdf", sep=""), height=5.5, width=9) 
200
WB20 = c(colorpanel(1, "#008566","#E1E56D"), colorpanel(20, "#E1E56D", "#742414")[-1])
201
op <- par(no.readonly=TRUE)
202
layout(matrix(c(1,2)),height=c(4,1.25),width=1)
203
par(mar=c(5,4,1,2)+.1, cex=1) # c(bottom, left, top, right)
204
## Draw the Scatter chart of combined results
205
### Get the random portfolios from one of the result sets
206
x.hhi=apply(xtract[,10:16], FUN='HHI', MARGIN=1)
207
y=(x.hhi-min(x.hhi))/(max(x.hhi)-min(x.hhi)) # normalized HHI between 0 and 1
208
plot(xtract[order(y,decreasing=TRUE),"StdDev"],xtract[order(y,decreasing=TRUE),"mean"], xlab="Ex Ante StdDev", ylab="Ex Ante Mean", col=WB20[floor(y[order(y,decreasing=TRUE)]*19)+1], axes=FALSE, main="", cex=.5, pch=16)
209
grid(col = "darkgray")
210
# points(RND.objectives[1,2],RND.objectives[1,1], col="blue", pch=19, cex=1.5)
211
axis(1, cex.axis = 0.7, col = "darkgray")
212
axis(2, cex.axis = 0.7, col = "darkgray")
213
box(col = "darkgray")
214

215
# Add legend to bottom panel
216
par(mar=c(5,5.5,1,3)+.1, cex=0.7)
217
## Create a histogramed legend for sequential colorsets
218
## this next bit of code is based on heatmap.2 in gplots package
219
x=x.hhi
220
scale01 <- function(x, low = min(x), high = max(x)) {
221
  return((x - low)/(high - low))
222
}
223
breaks <- seq(min(x, na.rm = TRUE), max(x, na.rm = TRUE), length = length(WB20)+1)
224
min.raw <- min(x, na.rm = TRUE)
225
max.raw <- max(x, na.rm = TRUE)
226
z <- seq(min.raw, max.raw, length = length(WB20))
227
image(z = matrix(z, ncol = 1), col = WB20, breaks = breaks, xaxt = "n", yaxt = "n")
228
par(usr = c(0, 1, 0, 1)) # needed to draw the histogram correctly
229
lv <- pretty(breaks)
230
xv <- scale01(as.numeric(lv), min.raw, max.raw)
231
axis(1, at = xv, labels=sprintf("%s%%", pretty(lv)))
232
h <- hist(x, plot = FALSE, breaks=breaks)
233
hx <- scale01(breaks, min(x), max(x))
234
hy <- c(h$counts, h$counts[length(h$counts)])
235
lines(hx, hy/max(hy)*.95, lwd = 2, type = "s", col = "blue")
236
axis(2, at = pretty(hy)/max(hy)*.95, pretty(hy))
237
title(ylab="Count")
238
title(xlab="Degree of Portfolio Concentration")
239
par(op)
240
dev.off()
241

242
# --------------------------------------------------------------------
243
# Show CONCENTRATION of the RP portfolios in HHI space
244
# --------------------------------------------------------------------
245
CairoPDF(file=paste(resultsdir, dataname, "-ConcPercESContrib-HHI-wHull.pdf", sep=""), height=5.5, width=9) 
246
WB20 = c(colorpanel(1, "#008566","#E1E56D"), colorpanel(20, "#E1E56D", "#742414")[-1])
247
op <- par(no.readonly=TRUE)
248
layout(matrix(c(1,2)),height=c(4,1.25),width=1)
249
par(mar=c(5,4,1,2)+.1, cex=1) # c(bottom, left, top, right)
250
seq.col = heat.colors(11)
251
## Draw the Scatter chart of combined results
252
### Get the random portfolios from one of the result sets
253
x.hhi=apply(xtract[,10:16], FUN='HHI', MARGIN=1)
254
y=(x.hhi-min(x.hhi))/(max(x.hhi)-min(x.hhi)) # normalized HHI between 0 and 1
255
plot(x.hhi[order(y,decreasing=TRUE)],xtract[order(y,decreasing=TRUE),"mean"], xlab="Degree of ex ante Risk Contribution", ylab="Ex Ante Mean", col=WB20[floor(y[order(y,decreasing=TRUE)]*19)+1], axes=FALSE, main="", cex=.5, pch=16)
256
grid(col = "darkgray")
257
# points(RND.objectives[1,2],RND.objectives[1,1], col="blue", pch=19, cex=1.5)
258
axis(1, cex.axis = 0.7, col = "darkgray")
259
axis(2, cex.axis = 0.7, col = "darkgray")
260
box(col = "darkgray")
261

262
# HOWTO add a hull to this diagram
263
# Make a data.frame out of your vectors
264
dat <- data.frame(X = x.hhi[order(y,decreasing=TRUE)], Y = xtract[order(y,decreasing=TRUE),"mean"])
265
dat <- data.frame(X = x.hhi, Y = xtract[,"mean"])
266
# Compute the convex hull. This returns the index for the X and Y coordinates
267
c.hull <- chull(dat)
268
#Extract the coordinate points from the convex hull with the index.
269
z=dat[c.hull,]
270
# Plot the full hull
271
# with(dat, plot(X,Y))
272
# lines(z, col = "pink", lwd = 3)
273

274
# Or just do the ascending hull in Y
275
z[,3] <- c(diff(as.numeric(z[,1])),z[1,1]-tail(z[,1],1)) # calculate whether the line segment is ascending in X
276
z[,4] <- c(tail(z[,2],1)-z[1,2],diff(as.numeric(z[,2]))) # calculate whether the line segment is ascending in Y
277
lines(z[z[,3]>0 & z[,4]>0,1:2], col = wb13color[1], lwd = 2, type="b")
278
z=cbind(z,c.hull)
279
# Here are the portfolios on the hull
280
hull.portfolios=z[which(z[,3]>0 & z[,4]>0),5]
281

282
# Add legend to bottom panel
283
par(mar=c(5,5.5,1,3)+.1, cex=0.7)
284
## Create a histogramed legend for sequential colorsets
285
## this next bit of code is based on heatmap.2 in gplots package
286
x=x.hhi
287
scale01 <- function(x, low = min(x), high = max(x)) {
288
  return((x - low)/(high - low))
289
}
290
breaks <- seq(min(x, na.rm = TRUE), max(x, na.rm = TRUE), length = length(WB20)+1)
291
min.raw <- min(x, na.rm = TRUE)
292
max.raw <- max(x, na.rm = TRUE)
293
z <- seq(min.raw, max.raw, length = length(WB20))
294
image(z = matrix(z, ncol = 1), col = WB20, breaks = breaks, xaxt = "n", yaxt = "n")
295
par(usr = c(0, 1, 0, 1)) # needed to draw the histogram correctly
296
lv <- pretty(breaks)
297
xv <- scale01(as.numeric(lv), min.raw, max.raw)
298
axis(1, at = xv, labels=pretty(lv))
299
h <- hist(x, plot = FALSE, breaks=breaks)
300
hx <- scale01(breaks, min(x), max(x))
301
hy <- c(h$counts, h$counts[length(h$counts)])
302
lines(hx, hy/max(hy)*.95, lwd = 2, type = "s", col = wb13color[8])
303
axis(2, at = pretty(hy)/max(hy)*.95, pretty(hy))
304
title(ylab="Count")
305
title(xlab="Degree of Portfolio Concentration")
306
par(op)
307
dev.off()
308

309

310
# --------------------------------------------------------------------
311
# Show CONCENTRATION of the RP portfolios in STD DEV space WITH HULL 
312
# --------------------------------------------------------------------
313
CairoPDF(file=paste(resultsdir, dataname, "-ConcPercESContrib-SD-wHull.pdf", sep=""), height=5.5, width=9) 
314
WB20 = c(colorpanel(1, "#008566","#E1E56D"), colorpanel(20, "#E1E56D", "#742414")[-1])
315
op <- par(no.readonly=TRUE)
316
layout(matrix(c(1,2)),height=c(4,1.25),width=1)
317
par(mar=c(5,4,1,2)+.1, cex=1) # c(bottom, left, top, right)
318
plot(xtract[order(y,decreasing=TRUE),"StdDev"],xtract[order(y,decreasing=TRUE),"mean"], xlab="Ex Ante StdDev", ylab="Ex Ante Mean", col=WB20[floor(y[order(y,decreasing=TRUE)]*19)+1], axes=FALSE, main="", cex=.5, pch=16)
319
# points(xtract[hull.portfolios,"StdDev"], xtract[hull.portfolios,"mean"], col='blue')
320
lines(xtract[hull.portfolios,"StdDev"], xtract[hull.portfolios,"mean"], type="b", col=wb13color[1], lwd=2)
321
grid(col = "darkgray")
322
axis(1, cex.axis = 0.7, col = "darkgray")
323
axis(2, cex.axis = 0.7, col = "darkgray")
324
box(col = "darkgray")
325

326
# Add legend to bottom panel
327
par(mar=c(5,5.5,1,3)+.1, cex=0.7)
328
## Create a histogramed legend for sequential colorsets
329
## this next bit of code is based on heatmap.2 in gplots package
330
x=x.hhi
331
scale01 <- function(x, low = min(x), high = max(x)) {
332
  return((x - low)/(high - low))
333
}
334
breaks <- seq(min(x, na.rm = TRUE), max(x, na.rm = TRUE), length = length(WB20)+1)
335
min.raw <- min(x, na.rm = TRUE)
336
max.raw <- max(x, na.rm = TRUE)
337
z <- seq(min.raw, max.raw, length = length(WB20))
338
image(z = matrix(z, ncol = 1), col = WB20, breaks = breaks, xaxt = "n", yaxt = "n")
339
par(usr = c(0, 1, 0, 1)) # needed to draw the histogram correctly
340
lv <- pretty(breaks)
341
xv <- scale01(as.numeric(lv), min.raw, max.raw)
342
axis(1, at = xv, labels=pretty(lv))
343
h <- hist(x, plot = FALSE, breaks=breaks)
344
hx <- scale01(breaks, min(x), max(x))
345
hy <- c(h$counts, h$counts[length(h$counts)])
346
lines(hx, hy/max(hy)*.95, lwd = 2, type = "s", col = wb13color[8])
347
axis(2, at = pretty(hy)/max(hy)*.95, pretty(hy))
348
title(ylab="Count")
349
title(xlab="Degree of Portfolio Concentration")
350
par(op)
351
dev.off()
352

353
# --------------------------------------------------------------------
354
# Show CONCENTRATION of the RP portfolios in ETL space WITH HULL 
355
# --------------------------------------------------------------------
356
CairoPDF(file=paste(resultsdir, dataname, "-ConcPercESContrib-mETL-wHull.pdf", sep=""), height=5.5, width=9) 
357
WB20 = c(colorpanel(1, "#008566","#E1E56D"), colorpanel(20, "#E1E56D", "#742414")[-1])
358
op <- par(no.readonly=TRUE)
359
layout(matrix(c(1,2)),height=c(4,1.25),width=1)
360
par(mar=c(5,4,1,2)+.1, cex=1) # c(bottom, left, top, right)
361
plot(xtract[order(y,decreasing=TRUE),"ES"],xtract[order(y,decreasing=TRUE),"mean"], xlab="Ex Ante mETL", ylab="Ex Ante Mean", col=WB20[floor(y[order(y,decreasing=TRUE)]*19)+1], axes=FALSE, main="", cex=.5, pch=16, cex.lab=1.1)
362
points(xtract[hull.portfolios,"ES"], xtract[hull.portfolios,"mean"], col='blue')
363
lines(xtract[hull.portfolios,"ES"], xtract[hull.portfolios,"mean"], type="b", col=wb13color[1], lwd=2)
364
grid(col = "darkgray")
365
axis(1, cex.axis = .7, col = "darkgray")
366
axis(2, cex.axis = .7, col = "darkgray")
367
box(col = "darkgray")
368
# Add legend to bottom panel
369
par(mar=c(5,5.5,1,3)+.1, cex=0.7)
370
## Create a histogramed legend for sequential colorsets
371
## this next bit of code is based on heatmap.2 in gplots package
372
x=x.hhi
373
scale01 <- function(x, low = min(x), high = max(x)) {
374
  return((x - low)/(high - low))
375
}
376
breaks <- seq(min(x, na.rm = TRUE), max(x, na.rm = TRUE), length = length(WB20)+1)
377
min.raw <- min(x, na.rm = TRUE)
378
max.raw <- max(x, na.rm = TRUE)
379
z <- seq(min.raw, max.raw, length = length(WB20))
380
image(z = matrix(z, ncol = 1), col = WB20, breaks = breaks, xaxt = "n", yaxt = "n")
381
par(usr = c(0, 1, 0, 1)) # needed to draw the histogram correctly
382
lv <- pretty(breaks)
383
xv <- scale01(as.numeric(lv), min.raw, max.raw)
384
axis(1, at = xv, labels=pretty(lv))
385
h <- hist(x, plot = FALSE, breaks=breaks)
386
hx <- scale01(breaks, min(x), max(x))
387
hy <- c(h$counts, h$counts[length(h$counts)])
388
lines(hx, hy/max(hy)*.95, lwd = 2, type = "s", col = wb13color[8])
389
axis(2, at = pretty(hy)/max(hy)*.95, pretty(hy))
390
title(ylab="Count")
391
title(xlab="Degree of Portfolio Concentration")
392
par(op)
393
dev.off()
394

395
  
396
### APPENDIX SLIDES:
397
  
398
# --------------------------------------------------------------------
399
# Show weights through time for MRC SD portfolio
400
# --------------------------------------------------------------------
401
print(load("results/MRCSD.DE.t-2013-10-17-historical.moments.rda"))
402
MRCSD.w = extractWeights(MRCSD.DE.t)
403
CairoPDF(file=paste(resultsdir, dataname, "-weights-SD.pdf", sep=""), height=5.5, width=9)
404
chart.UnStackedBar(MRCSD.w, rotate="horizontal", colorset=wb13color, space=0, las=3, cex.axis=0.7, cex.names=0.8)
405
dev.off()
406

407
# --------------------------------------------------------------------
408
# Show percent contribution of MRC SD through time
409
# --------------------------------------------------------------------
410
# Extract perc contrib of mES from results object
411
x=NULL
412
for(i in 1:length(names(MRCSD.DE.t)))  {
413
  x = rbind(x,MRCSD.DE.t[[i]][["objective_measures"]]$StdDev$pct_contrib_StdDev)
414
}
415
x.xts = as.xts(x, order.by=as.POSIXct(names(MRCSD.DE.t)))
416
  colnames(x.xts)=names(MRCmETL.DE.t[[1]][["objective_measures"]]$StdDev$pct_contrib_StdDev)
417
CairoPDF(file=paste(resultsdir, dataname, "-contribution-SD.pdf", sep=""), height=5.5, width=9)
418
chart.UnStackedBar(x.xts, rotate="horizontal", colorset=wb13color, space=0, las=3, cex.axis=0.7, cex.names=0.8)
419
dev.off()
420
  
421
# --------------------------------------------------------------------
422
# Show weights through time for MRC mETL portfolio
423
# --------------------------------------------------------------------
424
print(load("results/MRCmETL.DE.t-2013-10-18-historical.moments.rda"))
425
MRCmETL.w = extractWeights(MRCmETL.DE.t)
426
CairoPDF(file=paste(resultsdir, dataname, "-weights-mETL.pdf", sep=""), height=5.5, width=9)
427
chart.UnStackedBar(MRCmETL.w, rotate="horizontal", colorset=wb13color, space=0, las=3, cex.axis=0.7, cex.names=0.8)
428
dev.off()
429

430
# --------------------------------------------------------------------
431
# Show percent contribution of mETL through time
432
# --------------------------------------------------------------------
433
# Extract perc contrib of mES from results object
434
x=NULL
435
for(i in 1:length(names(MRCmETL.DE.t)))  {
436
  x = rbind(x,MRCmETL.DE.t[[i]][["objective_measures"]]$ES$pct_contrib_MES)
437
}
438
x.xts = as.xts(x, order.by=as.POSIXct(names(MRCmETL.DE.t)))
439
colnames(x.xts)=names(MRCmETL.DE.t[[1]][["objective_measures"]]$ES$pct_contrib_MES)
440
CairoPDF(file=paste(resultsdir, dataname, "-contribution-mETL.pdf", sep=""), height=5.5, width=9)
441
chart.UnStackedBar(x.xts, rotate="horizontal", colorset=wb13color, space=0, las=3, cex.axis=0.7, cex.names=0.8)
442
dev.off()
443
  
444
# --------------------------------------------------------------------
445
# Show out-of-sample performance of buoy portfolios
446
# --------------------------------------------------------------------
447
  EqWgt.opt$weights
448
dates=index(R[endpoints(R, on="years")])
449
EqWgt.w = xts(matrix(rep(1/NCOL(R),length(dates)*NCOL(R)), ncol=NCOL(R)), order.by=dates)
450
EqWgt.R = Return.rebalancing(R, EqWgt.w)
451
MRCSD.R = Return.rebalancing(R, MRCSD.w)  
452
MRCmETL.R = Return.rebalancing(R, MRCmETL.w)
453
x.R = cbind(EqWgt.R, VolWgt.R, MRCSD.R, MRCmETL.R)
454
colnames(x.R)=c("Eq Wgt", "Vol Wgt", "MRC SD", "MRC mETL")
455
CairoPDF(file=paste(resultsdir, dataname, "-OOS-relative-performance.pdf", sep=""), height=5.5, width=9)
456
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")
457
dev.off()
458

459
table.RiskStats(x.R["2000::"], p=1-1/12)
460
  
461
R.boudt=Return.clean(R, method="boudt")
462
# --------------------------------------------------------------------
463
# From Inception Mean of constituents
464
# --------------------------------------------------------------------
465
x.mean=apply.fromstart(R,FUN="mean")
466
x.mean=as.xts(x.mean)
467
CairoPDF(file=paste(resultsdir, dataname, "-from-inception-mean.pdf", sep=""), height=5.5, width=9)
468
chart.TimeSeries(x.mean["2000-01::",],legend.loc="topright", colorset=wb13color, pch="", lwd=3, main="From-Inception Mean")
469
dev.off()
470

471
# --------------------------------------------------------------------
472
# From Inception Volatility of constituents
473
# --------------------------------------------------------------------
474
x.vol=apply.fromstart(R,FUN="StdDev")
475
x.vol=as.xts(x.vol)
476
CairoPDF(file=paste(resultsdir, dataname, "-from-inception-vol.pdf", sep=""), height=5.5, width=9)
477
chart.TimeSeries(x.vol["2000-01::",],legend.loc="bottomleft", colorset=wb13color, pch="", lwd=3, main="From-Inception Volatility")
478
dev.off()
479
  
480
# --------------------------------------------------------------------
481
# From Inception Skewness of constituents
482
# --------------------------------------------------------------------
483
x.skew=apply.fromstart(R,FUN="skewness")
484
x.skew=as.xts(x.skew)
485
CairoPDF(file=paste(resultsdir, dataname, "-from-inception-skew.pdf", sep=""), height=5.5, width=9)
486
chart.TimeSeries(x.skew["2000-01::",],legend.loc="bottomleft", colorset=wb13color, pch="", lwd=3, main="From-Inception Skewness")
487
dev.off()
488
  
489
# --------------------------------------------------------------------
490
# From Inception Kurtosis of constituents
491
# --------------------------------------------------------------------
492
x.kurt=apply.fromstart(R,FUN="kurtosis")
493
x.kurt=as.xts(x.kurt)
494
CairoPDF(file=paste(resultsdir, dataname, "-from-inception-kurt.pdf", sep=""), height=5.5, width=9)
495
chart.TimeSeries(x.kurt["2000-01::",],legend.loc="topleft", colorset=wb13color, pch="", lwd=3, main="From-Inception Kurtosis")
496
dev.off()
497
Product

Resources

Company
