CoCalc -- optimization

GitHub Repository: braverock/portfolioanalytics
Path: blob/master/sandbox/RFinance2014/optimization_analysis.R
¹⁴³³ views
1
library(PortfolioAnalytics)
2
library(methods)
3

4
# rCharts charting functions
5
source("R/charting.R")
6

7
# Set the directory where the optimization results are saved
8
results.dir <- "optimization_results"
9
figures.dir <- "figures"
10

11
fig.height <- 450
12
fig.width <- 950
13

14
# mix of blue, green, and red hues
15
my_colors <- c("#a6cee3", "#1f78b4", "#b2df8a", "#33a02c", "#fb9a99", "#e31a1c")
16

17

18
##### Ledoit-Wolf Shrinkage Example #####
19
load(paste(results.dir, "opt.minVarSample.rda", sep="/"))
20
load(paste(results.dir, "opt.minVarLW.rda", sep="/"))
21

22
n <- length(opt.minVarSample$portfolio$assets)
23
# tmp_colors <- sample(colorRampPalette(c("dodgerblue", "gray", "orange"))(n), n, FALSE)
24
tmp_colors <- colorRampPalette(c("lightgreen", "dodgerblue", "#fff7bc"))(n)
25
# Chart the weights through time
26
png(paste(figures.dir, "weights_minVarSample.png", sep="/"))
27
chart.Weights(opt.minVarSample, main="minVarSample Weights", legend.loc=NULL, 
28
              col=tmp_colors)
29
dev.off()
30

31
w1 <- nvd3WeightsPlot(opt.minVarSample)
32
w1$chart(color = tmp_colors)
33
save(w1, file=paste(figures.dir, "w1.rda", sep="/"))
34

35

36
png(paste(figures.dir, "weights_minVarLW.png", sep="/"))
37
chart.Weights(opt.minVarLW, main="minVarLW Weights", legend.loc=NULL, 
38
              col=tmp_colors)
39
dev.off()
40

41
w2 <- nvd3WeightsPlot(opt.minVarLW)
42
w2$chart(color = tmp_colors)
43
save(w2, file=paste(figures.dir, "w2.rda", sep="/"))
44

45
# Compute the returns and chart the performance summary
46
ret.minVarSample <- summary(opt.minVarSample)$portfolio_returns
47
ret.minVarRobust <- summary(opt.minVarLW)$portfolio_returns
48
ret.minVar <- cbind(ret.minVarSample, ret.minVarRobust)
49
colnames(ret.minVar) <- c("Sample", "LW")
50

51
png(paste(figures.dir, "ret_minVar.png", sep="/"), height = fig.height, width = fig.width)
52
charts.PerformanceSummary(ret.minVar, colorset=bluemono)
53
dev.off()
54

55
##### Market Neutral Example #####
56
load(paste(results.dir, "opt.dn.rda", sep="/"))
57

58
png(paste(figures.dir, "opt_dn.png", sep="/"), height = fig.height, width = fig.width)
59
plot(opt.dn, main="Dollar Neutral Portfolio", risk.col="StdDev", neighbors=10)
60
dev.off()
61

62

63
# chart.RiskReward(opt, risk.col="StdDev", neighbors=25)
64
# chart.Weights(opt, plot.type="bar", legend.loc=NULL)
65
# wts <- extractWeights(opt)
66
# t(wts) %*% betas
67
# sum(abs(wts))
68
# sum(wts[wts > 0])
69
# sum(wts[wts < 0])
70
# sum(wts != 0)
71

72
##### Example 3 #####
73
load(file=paste(results.dir, "opt.minES.rda", sep="/"))
74
load(file=paste(results.dir, "bt.opt.minES.rda", sep="/"))
75

76
# ES(R, portfolio_method="component", weights=extractWeights(opt.minES[[1]]))
77
# extractObjectiveMeasures(opt.minES)
78

79
# extract objective measures, out, and weights 
80
xtract <- extractStats(opt.minES)
81

82
# get the 'mean' and 'ES' columns from each element of the list
83
xtract.mean <- unlist(lapply(xtract, function(x) x[,"mean"]))
84
xtract.ES <- unlist(lapply(xtract, function(x) x[,"ES"]))
85

86

87
png(paste(figures.dir, "opt_minES.png", sep="/"), height = fig.height, width = fig.width)
88
# plot the feasible space
89
par(mar=c(7,4,4,1)+0.1)
90
plot(xtract.ES, xtract.mean, col="gray", 
91
     main="Minimum ES Portfolios",
92
     xlab="ES", ylab="Mean",
93
     ylim=c(0.005, 0.007),
94
     xlim=c(0.015, 0.085))
95

96
# min ES
97
points(x=opt.minES[[1]]$objective_measures$ES$MES,
98
       y=opt.minES[[1]]$objective_measures$mean,
99
       pch=15, col="purple")
100
text(x=opt.minES[[1]]$objective_measures$ES$MES,
101
     y=opt.minES[[1]]$objective_measures$mean,
102
     labels="Min ES", pos=1, col="purple", cex=0.8)
103

104
# min ES with risk budget upper limit on component contribution to risk
105
points(x=opt.minES[[2]]$objective_measures$ES$MES,
106
       y=opt.minES[[2]]$objective_measures$mean,
107
       pch=15, col="black")
108
text(x=opt.minES[[2]]$objective_measures$ES$MES,
109
     y=opt.minES[[2]]$objective_measures$mean,
110
     labels="Min ES RB", pos=4, col="black", cex=0.8)
111

112
# min ES with equal (i.e. min concentration) component contribution to risk
113
points(x=opt.minES[[3]]$objective_measures$ES$MES,
114
       y=opt.minES[[3]]$objective_measures$mean,
115
       pch=15, col="darkgreen")
116
text(x=opt.minES[[3]]$objective_measures$ES$MES,
117
     y=opt.minES[[3]]$objective_measures$mean,
118
     labels="Min ES EqRB", pos=4, col="darkgreen", cex=0.8)
119
par(mar=c(5,4,4,1)+0.1)
120
dev.off()
121

122
# Chart the risk contribution
123
#chart.RiskBudget(opt.minES[[1]], risk.type="percentage", neighbors=10)
124
png(paste(figures.dir, "rb_minES.png", sep="/"))
125
chart.RiskBudget(opt.minES[[2]], main="Risk Budget Limit", 
126
                 risk.type="percentage", neighbors=10)
127
dev.off()
128

129
png(paste(figures.dir, "eqrb_minES.png", sep="/"))
130
chart.RiskBudget(opt.minES[[3]], main="Equal ES Component Contribution", 
131
                 risk.type="percentage", neighbors=10)
132
dev.off()
133

134
# Plot the risk contribution  of portfolio 1 through time
135
png(paste(figures.dir, "risk_minES.png", sep="/"))
136
chart.RiskBudget(bt.opt.minES[[1]], main="Min ES Risk Contribution", 
137
                 risk.type="percentage", col=my_colors)
138
dev.off()
139
# Plot the risk contribution  of portfolio 1 through time
140
png(paste(figures.dir, "weights_minES.png", sep="/"))
141
chart.Weights(bt.opt.minES[[1]], main="Min ES Weights", col=my_colors)
142
dev.off()
143

144
# Plot the risk contribution  of portfolio 3 through time
145
png(paste(figures.dir, "risk_minESRB.png", sep="/"))
146
chart.RiskBudget(bt.opt.minES[[2]], main="Min ES RB Risk Contribution",
147
                 risk.type="percentage", col=my_colors)
148
dev.off()
149
# Plot the weights of portfolio 2 through time
150
png(paste(figures.dir, "weights_minESRB.png", sep="/"))
151
chart.Weights(bt.opt.minES[[2]], main="Min ES RB Weights", col=my_colors)
152
dev.off()
153

154
# Plot the risk contribution  of portfolio 3 through time
155
png(paste(figures.dir, "risk_minESEqRB.png", sep="/"))
156
chart.RiskBudget(bt.opt.minES[[3]], main="Min ES EqRB Risk Contribution",
157
                 risk.type="percentage", col=my_colors)
158
dev.off()
159
# Plot the weights of portfolio 3 through time
160
png(paste(figures.dir, "weights_minESEqRB.png", sep="/"))
161
chart.Weights(bt.opt.minES[[3]], main="Min ES EqRB Weights", col=my_colors)
162
dev.off()
163

164
bt_w3 <- nvd3WeightsPlot(bt.opt.minES[[3]], "multiBarChart")
165
bt_w3$chart(color = my_colors)
166
save(bt_w3, file=paste(figures.dir, "bt_w3.rda", sep="/"))
167

168
bt_rb3 <- nvd3RiskPlot(bt.opt.minES[[3]], "multiBarChart")
169
bt_rb3$chart(color = my_colors)
170
save(bt_rb3, file=paste(figures.dir, "bt_rb3.rda", sep="/"))
171

172
# Extract the returns from each element and chart the performance summary
173
ret.bt.opt <- do.call(cbind, lapply(bt.opt.minES, 
174
                                    function(x) summary(x)$portfolio_returns))
175
colnames(ret.bt.opt) <- c("min ES", "min ES RB", "min ES Eq RB")
176

177
png(paste(figures.dir, "ret_minES.png", sep="/"), height = fig.height, width = fig.width)
178
charts.PerformanceSummary(ret.bt.opt, colorset=my_colors[c(2,4,6)])
179
dev.off()
180

181
###
182
# interactive plot of risk budgets through time using nvd3
183
# nvd3RiskPlot(bt.opt.minES[[1]])
184
# nvd3RiskPlot(bt.opt.minES[[2]])
185
# nvd3RiskPlot(bt.opt.minES[[3]])
186
###
187

188
##### Example 4 #####
189
load(file=paste(results.dir, "opt.crra.rda", sep="/"))
190
load(file=paste(results.dir, "bt.opt.crra.rda", sep="/"))
191

192
CRRA <- function(R, weights, lambda, sigma, m3, m4){
193
  weights <- matrix(weights, ncol=1)
194
  M2.w <- t(weights) %*% sigma %*% weights
195
  M3.w <- t(weights) %*% m3 %*% (weights %x% weights)
196
  M4.w <- t(weights) %*% m4 %*% (weights %x% weights %x% weights)
197
  term1 <- 0.5 * lambda * M2.w
198
  term2 <- (1 / 6) * lambda * (lambda + 1) * M3.w
199
  term3 <- (1 / 24) * lambda * (lambda + 1) * (lambda + 2) * M4.w
200
  out <- -term1 + term2 - term3
201
  out
202
}
203

204
# Chart the optimization in Risk-Reward space
205
png(paste(figures.dir, "crra_RR_ES.png", sep="/"))
206
chart.RiskReward(opt.crra, risk.col="ES")
207
dev.off()
208

209
png(paste(figures.dir, "crra_RR_StdDev.png", sep="/"))
210
chart.RiskReward(opt.crra, risk.col="StdDev")
211
dev.off()
212

213
png(paste(figures.dir, "weights_crra.png", sep="/"), height = fig.height, width = fig.width)
214
chart.Weights(bt.opt.crra, main="CRRA Weights", col=my_colors)
215
dev.off()
216

217
# Compute the portfolio returns with rebalancing
218
ret.crra <- summary(bt.opt.crra)$portfolio_returns
219
colnames(ret.crra) <- "CRRA"
220

221
# Plot the performance summary of the returns from example 3 and CRRA
222
png(paste(figures.dir, "ret_crra.png", sep="/"), height = fig.height, width = fig.width)
223
charts.PerformanceSummary(cbind(ret.bt.opt, ret.crra), 
224
                          main="Optimization Performance",
225
                          colorset=c(my_colors[c(2,4,6)], "black"))
226
dev.off()
227

228

229
Product

Resources

Company
