CoCalc -- charts.efficient.frontier.R

GitHub Repository: braverock/portfolioanalytics
Path: blob/master/R/charts.efficient.frontier.R
¹⁴³³ views
1

2
#' Chart the efficient frontier and risk-return scatter
3
#' 
4
#' Chart the efficient frontier and risk-return scatter of the assets for 
5
#' \code{optimize.portfolio} or \code{efficient.frontier} objects
6
#' 
7
#' @details
8
#' For objects created by optimize.portfolio with 'DEoptim', 'random', or 'pso'
9
#' specified as the optimize_method:
10
#' \itemize{
11
#'   \item The efficient frontier plotted is based on the the trace information (sets of 
12
#'   portfolios tested by the solver at each iteration) in objects created by 
13
#'   \code{optimize.portfolio}.
14
#' }
15
#' 
16
#' For objects created by optimize.portfolio with 'ROI' specified as the 
17
#' optimize_method:
18
#' \itemize{
19
#'   \item The mean-StdDev or mean-ETL efficient frontier can be plotted for optimal
20
#'   portfolio objects created by \code{optimize.portfolio}.
21
#' 
22
#'   \item If \code{match.col="StdDev"}, the mean-StdDev efficient frontier is plotted.
23
#' 
24
#'   \item If \code{match.col="ETL"} (also "ES" or "CVaR"), the mean-ETL efficient frontier is plotted.
25
#' }
26
#' 
27
#' Note that \code{trace=TRUE} must be specified in \code{\link{optimize.portfolio}}
28
#' 
29
#' GenSA does not return any useable trace information for portfolios tested at 
30
#' each iteration, therfore we cannot extract and chart an efficient frontier.
31
#' 
32
#' By default, the tangency portfolio (maximum Sharpe Ratio or modified Sharpe Ratio)
33
#' will be plotted using a risk free rate of 0. Set \code{rf=NULL} to omit 
34
#' this from the plot. 
35
#' 
36
#' @param object object to chart.
37
#' @param \dots passthru parameters to \code{\link{plot}}
38
#' @param optimize_method the optimize method to get the efficient frontier
39
#' @param match.col string name of column to use for risk (horizontal axis).
40
#' \code{match.col} must match the name of an objective measure in the 
41
#' \code{objective_measures} or \code{opt_values} slot in the object created 
42
#' by \code{\link{optimize.portfolio}}.
43
#' @param n.portfolios number of portfolios to use to plot the efficient frontier.
44
#' @param xlim set the x-axis limit, same as in \code{\link{plot}}.
45
#' @param ylim set the y-axis limit, same as in \code{\link{plot}}.
46
#' @param cex.axis numerical value giving the amount by which the axis should be magnified relative to the default.
47
#' @param element.color provides the color for drawing less-important chart elements, such as the box lines, axis lines, etc.
48
#' @param main a main title for the plot.
49
#' @param RAR.text string name for risk adjusted return text to plot in the legend.
50
#' @param rf risk free rate. If \code{rf} is not null, the maximum Sharpe Ratio or modified Sharpe Ratio tangency portfolio will be plotted.
51
#' @param tangent.line TRUE/FALSE to plot the tangent line.
52
#' @param cex.legend numerical value giving the amount by which the legend should be magnified relative to the default.
53
#' @param chart.assets TRUE/FALSE to include the assets.
54
#' @param labels.assets TRUE/FALSE to include the asset names in the plot. 
55
#' \code{chart.assets} must be \code{TRUE} to plot asset names.
56
#' @param pch.assets plotting character of the assets, same as in \code{\link{plot}}.
57
#' @param cex.assets numerical value giving the amount by which the asset points and labels should be magnified relative to the default.
58
#' @author Ross Bennett, Xinran Zhao
59
#' @rdname chart.EfficientFrontier
60
#' @export
61
chart.EfficientFrontier <- function(object, ...){
62
  UseMethod("chart.EfficientFrontier")
63
}
64

65
#' @rdname chart.EfficientFrontier
66
#' @method chart.EfficientFrontier optimize.portfolio.CVXR
67
#' @export
68
chart.EfficientFrontier.optimize.portfolio.CVXR <- function(object, ..., optimize_method='CVXR', match.col="ES", n.portfolios=25, xlim=NULL, ylim=NULL, cex.axis=0.8, element.color="darkgray", main="Efficient Frontier", RAR.text="SR", rf=0, tangent.line=TRUE, cex.legend=0.8, chart.assets=TRUE, labels.assets=TRUE, pch.assets=21, cex.assets=0.8){
69
  if(!inherits(object, "optimize.portfolio.CVXR")) stop("object must be of class optimize.portfolio.CVXR")
70
  
71
  portf <- object$portfolio
72
  R <- object$R
73
  if(is.null(R)) stop(paste("Not able to get asset returns from", object))
74
  wts <- object$weights
75
  objectclass <- class(object)[1]
76
  
77
  # objnames <- unlist(lapply(portf$objectives, function(x) x$name))
78
  # if(!(match.col %in% objnames)){
79
  #   stop("match.col must match an objective name")
80
  # }
81
  
82
  # get the optimal return and risk metrics
83
  xtract <- extractStats(object=object)
84
  columnames <- names(xtract)
85
  if(!(("mean") %in% columnames)){
86
    # we need to calculate the mean given the optimal weights
87
    opt_ret <- applyFUN(R=R, weights=wts, FUN="mean")
88
  } else {
89
    opt_ret <- xtract["mean"]
90
  }
91
  # get the match.col column
92
  mtc <- pmatch(match.col, columnames)
93
  if(is.na(mtc)) {
94
    mtc <- pmatch(paste(match.col,match.col,sep='.'), columnames)
95
  }
96
  if(is.na(mtc)){
97
    # if(is.na(mtc)) stop("could not match match.col with column name of extractStats output")
98
    opt_risk <- applyFUN(R=R, weights=wts, FUN=match.col)
99
  } else {
100
    opt_risk <- xtract[mtc]
101
  }
102
  
103
  # get the data to plot scatter of asset returns
104
  asset_ret <- scatterFUN(R=R, FUN="mean")
105
  asset_risk <- scatterFUN(R=R, FUN=match.col)
106
  rnames <- colnames(R)
107
  
108
  if(match.col == "StdDev"){
109
    frontier <- meanvar.efficient.frontier(portfolio=portf, R=R, n.portfolios=n.portfolios, ...=...)
110
    rar <- "SR"
111
  }
112
  if(match.col %in% c("ETL", "ES", "CVaR")){
113
    frontier <- meanetl.efficient.frontier(portfolio=portf, R=R, n.portfolios=n.portfolios, ...=...)
114
    rar <- "STARR"
115
  }
116
  if(match.col =="CSM"){
117
    frontier <- meancsm.efficient.frontier(portfolio=portf, R=R, n.portfolios=n.portfolios, ...=...)
118
    rar <- "CSMratio"
119
  }
120
  
121
  # data points to plot the frontier
122
  x.f <- frontier[, match.col]
123
  y.f <- frontier[, "mean"]
124
  
125
  # Points for the Sharpe Ratio ((mu - rf) / StdDev) or STARR ((mu - rf) / ETL)
126
  if(!is.null(rf)){
127
    sr <- (y.f - rf) / (x.f)
128
    idx.maxsr <- which.max(sr)
129
    srmax <- sr[idx.maxsr]
130
  }
131
  
132
  # set the x and y limits
133
  if(is.null(xlim)){
134
    xlim <- range(c(x.f, asset_risk))
135
    # xlim[1] <- xlim[1] * 0.8
136
    xlim[1] <- 0
137
    xlim[2] <- xlim[2] * 1.15
138
  }
139
  if(is.null(ylim)){
140
    ylim <- range(c(y.f, asset_ret))
141
    # ylim[1] <- ylim[1] * 0.9
142
    ylim[1] <- 0
143
    ylim[2] <- ylim[2] * 1.1
144
  }
145
  
146
  # plot the efficient frontier line
147
  plot(x=x.f, y=y.f, ylab="Mean", xlab=match.col, main=main, xlim=xlim, ylim=ylim, axes=FALSE, ...)
148
  
149
  # Add the global minimum variance or global minimum ETL portfolio
150
  points(x=x.f[1], y=y.f[1], pch=16)
151
  
152
  if(chart.assets){
153
    # risk-return scatter of the assets
154
    points(x=asset_risk, y=asset_ret, pch=pch.assets, cex=cex.assets)
155
    if(labels.assets) text(x=asset_risk, y=asset_ret, labels=rnames, pos=4, cex=cex.assets)
156
  }
157
  
158
  # plot the optimal portfolio
159
  points(opt_risk, opt_ret, col="blue", pch=16) # optimal
160
  text(x=opt_risk, y=opt_ret, labels="Optimal",col="blue", pos=4, cex=0.8)
161
  if(!is.null(rf)){
162
    # Plot tangency line and points at risk-free rate and tangency portfolio
163
    if(tangent.line) abline(rf, srmax, lty=2)
164
    points(0, rf, pch=16)
165
    points(x.f[idx.maxsr], y.f[idx.maxsr], pch=16)
166
    # text(x=x.f[idx.maxsr], y=y.f[idx.maxsr], labels="T", pos=4, cex=0.8)
167
    # Add lengend with max Sharpe Ratio and risk-free rate
168
    legend("topleft", paste(RAR.text, " = ", signif(srmax,3), sep = ""), bty = "n", cex=cex.legend)
169
    legend("topleft", inset = c(0,0.05), paste("rf = ", signif(rf,3), sep = ""), bty = "n", cex=cex.legend)
170
  }
171
  axis(1, cex.axis = cex.axis, col = element.color)
172
  axis(2, cex.axis = cex.axis, col = element.color)
173
  box(col = element.color)
174
}
175

176
#' @rdname chart.EfficientFrontier
177
#' @method chart.EfficientFrontier optimize.portfolio.ROI
178
#' @export
179
chart.EfficientFrontier.optimize.portfolio.ROI <- function(object, ..., optimize_method='ROI', match.col="ES", n.portfolios=25, xlim=NULL, ylim=NULL, cex.axis=0.8, element.color="darkgray", main="Efficient Frontier", RAR.text="SR", rf=0, tangent.line=TRUE, cex.legend=0.8, chart.assets=TRUE, labels.assets=TRUE, pch.assets=21, cex.assets=0.8){
180
  if(!inherits(object, "optimize.portfolio.ROI")) stop("object must be of class optimize.portfolio.ROI")
181
  
182
  portf <- object$portfolio
183
  R <- object$R
184
  if(is.null(R)) stop(paste("Not able to get asset returns from", object))
185
  wts <- object$weights
186
  objectclass <- class(object)[1]
187
  
188
  # objnames <- unlist(lapply(portf$objectives, function(x) x$name))
189
  # if(!(match.col %in% objnames)){
190
  #   stop("match.col must match an objective name")
191
  # }
192
  
193
  # get the optimal return and risk metrics
194
  xtract <- extractStats(object=object)
195
  columnames <- names(xtract)
196
  if(!(("mean") %in% columnames)){
197
    # we need to calculate the mean given the optimal weights
198
    opt_ret <- applyFUN(R=R, weights=wts, FUN="mean")
199
  } else {
200
    opt_ret <- xtract["mean"]
201
  }
202
  # get the match.col column
203
  mtc <- pmatch(match.col, columnames)
204
  if(is.na(mtc)) {
205
    mtc <- pmatch(paste(match.col,match.col,sep='.'), columnames)
206
  }
207
  if(is.na(mtc)){
208
    # if(is.na(mtc)) stop("could not match match.col with column name of extractStats output")
209
    opt_risk <- applyFUN(R=R, weights=wts, FUN=match.col)
210
  } else {
211
    opt_risk <- xtract[mtc]
212
  }
213
  
214
  # get the data to plot scatter of asset returns
215
  asset_ret <- scatterFUN(R=R, FUN="mean")
216
  asset_risk <- scatterFUN(R=R, FUN=match.col)
217
  rnames <- colnames(R)
218
  
219
  if(match.col %in% c("ETL", "ES", "CVaR")){
220
    frontier <- meanetl.efficient.frontier(portfolio=portf, R=R, n.portfolios=n.portfolios, ...=...)
221
    rar <- "STARR"
222
  }
223
  if(match.col == "StdDev"){
224
    frontier <- meanvar.efficient.frontier(portfolio=portf, R=R, n.portfolios=n.portfolios, ...=...)
225
    rar <- "SR"
226
  }
227
  # data points to plot the frontier
228
  x.f <- frontier[, match.col]
229
  y.f <- frontier[, "mean"]
230
  
231
  # Points for the Sharpe Ratio ((mu - rf) / StdDev) or STARR ((mu - rf) / ETL)
232
  if(!is.null(rf)){
233
    sr <- (y.f - rf) / (x.f)
234
    idx.maxsr <- which.max(sr)
235
    srmax <- sr[idx.maxsr]
236
  }
237
  
238
  # set the x and y limits
239
  if(is.null(xlim)){
240
    xlim <- range(c(x.f, asset_risk))
241
    # xlim[1] <- xlim[1] * 0.8
242
    xlim[1] <- 0
243
    xlim[2] <- xlim[2] * 1.15
244
  }
245
  if(is.null(ylim)){
246
    ylim <- range(c(y.f, asset_ret))
247
    # ylim[1] <- ylim[1] * 0.9
248
    ylim[1] <- 0
249
    ylim[2] <- ylim[2] * 1.1
250
  }
251
  
252
  # plot the efficient frontier line
253
  plot(x=x.f, y=y.f, ylab="Mean", xlab=match.col, main=main, xlim=xlim, ylim=ylim, axes=FALSE, ...)
254
  
255
  # Add the global minimum variance or global minimum ETL portfolio
256
  points(x=x.f[1], y=y.f[1], pch=16)
257
  
258
  if(chart.assets){
259
    # risk-return scatter of the assets
260
    points(x=asset_risk, y=asset_ret, pch=pch.assets, cex=cex.assets)
261
    if(labels.assets) text(x=asset_risk, y=asset_ret, labels=rnames, pos=4, cex=cex.assets)
262
  }
263
  
264
  # plot the optimal portfolio
265
  points(opt_risk, opt_ret, col="blue", pch=16) # optimal
266
  text(x=opt_risk, y=opt_ret, labels="Optimal",col="blue", pos=4, cex=0.8)
267
  if(!is.null(rf)){
268
    # Plot tangency line and points at risk-free rate and tangency portfolio
269
    if(tangent.line) abline(rf, srmax, lty=2)
270
    points(0, rf, pch=16)
271
    points(x.f[idx.maxsr], y.f[idx.maxsr], pch=16)
272
    # text(x=x.f[idx.maxsr], y=y.f[idx.maxsr], labels="T", pos=4, cex=0.8)
273
    # Add lengend with max Sharpe Ratio and risk-free rate
274
    legend("topleft", paste(RAR.text, " = ", signif(srmax,3), sep = ""), bty = "n", cex=cex.legend)
275
    legend("topleft", inset = c(0,0.05), paste("rf = ", signif(rf,3), sep = ""), bty = "n", cex=cex.legend)
276
  }
277
  axis(1, cex.axis = cex.axis, col = element.color)
278
  axis(2, cex.axis = cex.axis, col = element.color)
279
  box(col = element.color)
280
}
281

282
#' @rdname chart.EfficientFrontier
283
#' @method chart.EfficientFrontier optimize.portfolio
284
#' @export
285
chart.EfficientFrontier.optimize.portfolio <- function(object, ..., match.col="ES", n.portfolios=25, xlim=NULL, ylim=NULL, cex.axis=0.8, element.color="darkgray", main="Efficient Frontier", RAR.text="SR", rf=0, tangent.line=TRUE, cex.legend=0.8, chart.assets=TRUE, labels.assets=TRUE, pch.assets=21, cex.assets=0.8){
286
  # This function will work with objects of class optimize.portfolio.DEoptim,
287
  # optimize.portfolio.random, and optimize.portfolio.pso
288
  
289
  if(inherits(object, "optimize.portfolio.GenSA")){
290
    stop("GenSA does not return any useable trace information for portfolios tested, thus we cannot extract an efficient frontier.")
291
  }
292
  
293
  if(!inherits(object, "optimize.portfolio")) stop("object must be of class optimize.portfolio")
294
  
295
  portf <- object$portfolio
296
  R <- object$R
297
  if(is.null(R)) stop(paste("Not able to get asset returns from", object))
298
  wts <- object$weights
299
  
300
  # get the stats from the object
301
  xtract <- extractStats(object=object)
302
  columnames <- colnames(xtract)
303
  
304
  # Check if match.col is in extractStats output
305
  if(!(match.col %in% columnames)){
306
    stop(paste(match.col, "is not a column in extractStats output"))
307
  }
308
  
309
  # check if 'mean' is in extractStats output
310
  if(!("mean" %in% columnames)){
311
    stop("mean is not a column in extractStats output")
312
  }
313
  
314
  # get the stats of the optimal portfolio
315
  optstats <- xtract[which.min(xtract[, "out"]), ]
316
  opt_ret <- optstats["mean"]
317
  opt_risk <- optstats[match.col]
318
  
319
  # get the data to plot scatter of asset returns
320
  asset_ret <- scatterFUN(R=R, FUN="mean")
321
  asset_risk <- scatterFUN(R=R, FUN=match.col)
322
  rnames <- colnames(R)
323
  
324
  # get the data of the efficient frontier
325
  frontier <- extract.efficient.frontier(object=object, match.col=match.col, n.portfolios=n.portfolios, ...=...)
326
  
327
  # data points to plot the frontier
328
  x.f <- frontier[, match.col]
329
  y.f <- frontier[, "mean"]
330
  
331
  # Points for the Sharpe or Modified Sharpe Ratio
332
  if(!is.null(rf)){
333
    sr <- (y.f - rf) / (x.f)
334
    idx.maxsr <- which.max(sr)
335
    srmax <- sr[idx.maxsr]
336
  }
337
  
338
  # set the x and y limits
339
  if(is.null(xlim)){
340
    xlim <- range(c(x.f, asset_risk))
341
    # xlim[1] <- xlim[1] * 0.8
342
    xlim[1] <- 0
343
    xlim[2] <- xlim[2] * 1.15
344
  }
345
  if(is.null(ylim)){
346
    ylim <- range(c(y.f, asset_ret))
347
    # ylim[1] <- ylim[1] * 0.9
348
    ylim[1] <- 0
349
    ylim[2] <- ylim[2] * 1.1
350
  }
351
  
352
  # plot the efficient frontier line
353
  plot(x=x.f, y=y.f, ylab="Mean", xlab=match.col, main=main, xlim=xlim, ylim=ylim, axes=FALSE, ...)
354
  
355
  # Add the global minimum variance or global minimum ETL portfolio
356
  points(x=x.f[1], y=y.f[1], pch=16)
357
  
358
  if(chart.assets){
359
    # risk-return scatter of the assets
360
    points(x=asset_risk, y=asset_ret, pch=pch.assets, cex=cex.assets)
361
    if(labels.assets) text(x=asset_risk, y=asset_ret, labels=rnames, pos=4, cex=cex.assets)
362
  }
363
  
364
  # plot the optimal portfolio
365
  points(opt_risk, opt_ret, col="blue", pch=16) # optimal
366
  text(x=opt_risk, y=opt_ret, labels="Optimal",col="blue", pos=4, cex=0.8)
367
  if(!is.null(rf)){
368
    # Plot tangency line and points at risk-free rate and tangency portfolio
369
    if(tangent.line) abline(rf, srmax, lty=2)
370
    points(0, rf, pch=16)
371
    points(x.f[idx.maxsr], y.f[idx.maxsr], pch=16)
372
    # text(x=x.f[idx.maxsr], y=y.f[idx.maxsr], labels="T", pos=4, cex=0.8)
373
    # Add lengend with max Sharpe Ratio and risk-free rate
374
    legend("topleft", paste(RAR.text, " = ", signif(srmax,3), sep = ""), bty = "n", cex=cex.legend)
375
    legend("topleft", inset = c(0,0.05), paste("rf = ", signif(rf,3), sep = ""), bty = "n", cex=cex.legend)
376
  }
377
  axis(1, cex.axis = cex.axis, col = element.color)
378
  axis(2, cex.axis = cex.axis, col = element.color)
379
  box(col = element.color)
380
}
381

382

383
#' Chart weights along an efficient frontier
384
#' 
385
#' This function produces a stacked barplot of weights along an efficient frontier.
386
#' 
387
#' @param object object of class \code{efficient.frontier} or \code{optimize.portfolio}.
388
#' @param \dots passthru parameters to \code{barplot}.
389
#' @param colorset color palette or vector of colors to use.
390
#' @param n.portfolios number of portfolios to extract along the efficient frontier.
391
#' @param by.groups TRUE/FALSE. If TRUE, the group weights are charted.
392
#' @param match.col string name of column to use for risk (horizontal axis). Must match the name of an objective.
393
#' @param main title used in the plot.
394
#' @param cex.lab the magnification to be used for x-axis and y-axis labels relative to the current setting of 'cex'.
395
#' @param cex.axis the magnification to be used for sizing the axis text relative to the current setting of 'cex', similar to \code{\link{plot}}.
396
#' @param cex.legend the magnification to be used for sizing the legend relative to the current setting of 'cex', similar to \code{\link{plot}}.
397
#' @param legend.labels character vector to use for the legend labels.
398
#' @param element.color provides the color for drawing less-important chart elements, such as the box lines, axis lines, etc.
399
#' @param legend.loc NULL, "topright", "right", or "bottomright". If legend.loc is NULL, the legend will not be plotted.
400
#' @author Ross Bennett
401
#' @rdname chart.EF.Weights
402
#' @export
403
chart.EF.Weights <- function(object, ...){
404
  UseMethod("chart.EF.Weights")
405
}
406

407

408
#' @rdname chart.EF.Weights
409
#' @method chart.EF.Weights efficient.frontier
410
#' @export
411
chart.EF.Weights.efficient.frontier <- function(object, ..., colorset=NULL, n.portfolios=25, by.groups=FALSE, match.col="ES", main="", cex.lab=0.8, cex.axis=0.8, cex.legend=0.8, legend.labels=NULL, element.color="darkgray", legend.loc="topright"){
412
  # using ideas from weightsPlot.R in fPortfolio package
413
  
414
  if(!inherits(object, "efficient.frontier")) stop("object must be of class 'efficient.frontier'")
415
  
416
  if(is.list(object)){
417
    # Objects created with create.EfficientFrontier will be a list of 2 elements
418
    frontier <- object$frontier
419
  } else {
420
    # Objects created with extractEfficientFrontier will only be an efficient.frontier object
421
    frontier <- object
422
  }
423
  
424
  
425
  # get the columns with weights
426
  cnames <- colnames(frontier)
427
  wts_idx <- grep(pattern="^w\\.", cnames)
428
  wts <- frontier[, wts_idx]
429
  
430
  if(by.groups){
431
    constraints <- get_constraints(object$portfolio)
432
    groups <- constraints$groups
433
    if(is.null(groups)) stop("group constraints not in portfolio object")
434
    if(!is.null(groups)){
435
      groupfun <- function(weights, groups){
436
        # This function is to calculate weights by group given the group list
437
        # and a matrix of weights along the efficient frontier
438
        ngroups <- length(groups)
439
        group_weights <- rep(0, ngroups)
440
        for(i in 1:ngroups){
441
          group_weights[i] <- sum(weights[groups[[i]]])
442
        }
443
        group_weights
444
      }
445
      wts <- t(apply(wts, 1, groupfun, groups=groups))
446
    }
447
  }
448
  
449
  # return along the efficient frontier
450
  # get the "mean" column
451
  mean.mtc <- pmatch("mean", cnames)
452
  if(is.na(mean.mtc)) {
453
    mean.mtc <- pmatch("mean.mean", cnames)
454
  }
455
  if(is.na(mean.mtc)) stop("could not match 'mean' with column name of extractStats output")
456
  
457
  # risk along the efficient frontier
458
  # get the match.col column
459
  mtc <- pmatch(match.col, cnames)
460
  if(is.na(mtc)) {
461
    mtc <- pmatch(paste(match.col,match.col,sep='.'),cnames)
462
  }
463
  if(is.na(mtc)) stop("could not match match.col with column name of extractStats output")
464
  
465
  # compute the weights for the barplot
466
  pos.weights <- +0.5 * (abs(wts) + wts)
467
  neg.weights <- -0.5 * (abs(wts) - wts)
468
  
469
  # Define Plot Range:
470
  ymax <- max(rowSums(pos.weights))
471
  ymin <- min(rowSums(neg.weights))
472
  range <- ymax - ymin
473
  ymax <- ymax + 0.005 * range
474
  ymin <- ymin - 0.005 * range
475
  dim <- dim(wts)
476
  range <- dim[1]
477
  xmin <- 0
478
  if(is.null(legend.loc)){
479
    xmax <- range
480
  } else {
481
    xmax <- range + 0.3 * range
482
  }
483
  
484
  # set the colorset if no colorset is passed in
485
  if(is.null(colorset))
486
    colorset <- 1:dim[2]
487
  
488
  # plot the positive weights
489
  barplot(t(pos.weights), col = colorset, space = 0, ylab = "",
490
          xlim = c(xmin, xmax), ylim = c(ymin, ymax),
491
          border = element.color, cex.axis=cex.axis, 
492
          axisnames=FALSE, ...)
493
  
494
  if(!is.null(legend.loc)){
495
    if(legend.loc %in% c("topright", "right", "bottomright")){
496
      # set the legend information
497
      if(is.null(legend.labels)){
498
        if(by.groups){
499
          legend.labels <- names(groups)
500
          if(is.null(legend.labels)) legend.labels <- constraints$group_labels
501
        } else {
502
          legend.labels <- gsub(pattern="^w\\.", replacement="", cnames[wts_idx])
503
        }
504
      }
505
      legend(legend.loc, legend = legend.labels, bty = "n", cex = cex.legend, fill = colorset)
506
    }
507
  }
508
  # plot the negative weights
509
  barplot(t(neg.weights), col = colorset, space = 0, add = TRUE, border = element.color, 
510
          cex.axis=cex.axis, axes=FALSE, axisnames=FALSE, ...)
511
  
512
  
513
  # Add labels
514
  ef.return <- frontier[, mean.mtc]
515
  ef.risk <- frontier[, mtc]
516
  n.risk <- length(ef.risk)
517
  n.labels <- 6
518
  M <- c(0, ( 1:(n.risk %/% n.labels) ) ) * n.labels + 1
519
  # use 3 significant digits
520
  axis(3, at = M, labels = signif(ef.risk[M], 3), cex.axis=cex.axis)
521
  axis(1, at = M, labels = signif(ef.return[M], 3), cex.axis=cex.axis)
522
  
523
  # axis labels and titles
524
  mtext(match.col, side = 3, line = 2, adj = 0.5, cex = cex.lab)
525
  mtext("Mean", side = 1, line = 2, adj = 0.5, cex = cex.lab)
526
  mtext("Weight", side = 2, line = 2, adj = 0.5, cex = cex.lab)
527
  # add title
528
  title(main=main, line=3)
529
  # mtext(main, adj = 0, line = 2.5, font = 2, cex = 0.8)
530
  box(col=element.color)
531
}
532

533
#' @rdname chart.EF.Weights
534
#' @method chart.EF.Weights optimize.portfolio
535
#' @export
536
chart.EF.Weights.optimize.portfolio <- function(object, ..., colorset=NULL, n.portfolios=25, by.groups=FALSE, match.col="ES", main="", cex.lab=0.8, cex.axis=0.8, cex.legend=0.8, legend.labels=NULL, element.color="darkgray", legend.loc="topright"){
537
  # chart the weights along the efficient frontier of an objected created by optimize.portfolio
538
  
539
  if(!inherits(object, "optimize.portfolio")) stop("object must be of class optimize.portfolio")
540
  
541
  frontier <- extractEfficientFrontier(object=object, match.col=match.col, n.portfolios=n.portfolios)
542
  chart.EF.Weights(object=frontier, colorset=colorset, ..., 
543
                   match.col=match.col, by.groups=by.groups, main=main, cex.lab=cex.lab, 
544
                   cex.axis=cex.axis, cex.legend=cex.legend, 
545
                   legend.labels=legend.labels, element.color=element.color,
546
                   legend.loc=legend.loc)
547
}
548

549
#' @rdname chart.EfficientFrontier
550
#' @method chart.EfficientFrontier efficient.frontier
551
#' @export
552
chart.EfficientFrontier.efficient.frontier <- function(object, ..., match.col="ES", n.portfolios=NULL, xlim=NULL, ylim=NULL, cex.axis=0.8, element.color="darkgray", main="Efficient Frontier", RAR.text="SR", rf=0, tangent.line=TRUE, cex.legend=0.8, chart.assets=TRUE, labels.assets=TRUE, pch.assets=21, cex.assets=0.8){
553
  if(!inherits(object, "efficient.frontier")) stop("object must be of class 'efficient.frontier'")
554
  
555
  # get the returns and efficient frontier object
556
  R <- object$R
557
  frontier <- object$frontier
558
  
559
  # get the column names from the frontier object
560
  cnames <- colnames(frontier)
561
  
562
  # get the "mean" column
563
  mean.mtc <- pmatch("mean", cnames)
564
  if(is.na(mean.mtc)) {
565
    mean.mtc <- pmatch("mean.mean", cnames)
566
  }
567
  if(is.na(mean.mtc)) stop("could not match 'mean' with column name of efficient frontier")
568
  
569
  # get the match.col column
570
  mtc <- pmatch(match.col, cnames)
571
  if(is.na(mtc)) {
572
    mtc <- pmatch(paste(match.col,match.col,sep='.'),cnames)
573
  }
574
  if(is.na(mtc)) stop("could not match match.col with column name of efficient frontier")
575
  
576
  if(chart.assets){
577
    # get the data to plot scatter of asset returns
578
    asset_ret <- scatterFUN(R=R, FUN="mean")
579
    asset_risk <- scatterFUN(R=R, FUN=match.col)
580
    rnames <- colnames(R)
581
  } else {
582
    asset_ret <- NULL
583
    asset_risk <- NULL
584
  }
585
  
586
  # set the x and y limits
587
  if(is.null(xlim)){
588
    xlim <- range(c(frontier[, mtc], asset_risk))
589
    # xlim[1] <- xlim[1] * 0.8
590
    xlim[1] <- 0
591
    xlim[2] <- xlim[2] * 1.15
592
  }
593
  if(is.null(ylim)){
594
    ylim <- range(c(frontier[, mean.mtc], asset_ret))
595
    # ylim[1] <- ylim[1] * 0.9
596
    ylim[1] <- 0
597
    ylim[2] <- ylim[2] * 1.1
598
  }
599
  
600
  if(!is.null(rf)){
601
    sr <- (frontier[, mean.mtc] - rf) / (frontier[, mtc])
602
    idx.maxsr <- which.max(sr)
603
    srmax <- sr[idx.maxsr]
604
  }
605
  
606
  # plot the efficient frontier line
607
  plot(x=frontier[, mtc], y=frontier[, mean.mtc], ylab="Mean", xlab=match.col, main=main, xlim=xlim, ylim=ylim, axes=FALSE, ...)
608
  
609
  # Add the global minimum variance or global minimum ETL portfolio
610
  points(x=frontier[1, mtc], y=frontier[1, mean.mtc], pch=16)
611
  
612
  if(chart.assets){
613
    # risk-return scatter of the assets
614
    points(x=asset_risk, y=asset_ret, pch=pch.assets, cex=cex.assets)
615
    if(labels.assets) text(x=asset_risk, y=asset_ret, labels=rnames, pos=4, cex=cex.assets)
616
  }
617
  
618
  if(!is.null(rf)){
619
    # Plot tangency line and points at risk-free rate and tangency portfolio
620
    if(tangent.line) abline(rf, srmax, lty=2)
621
    points(0, rf, pch=16)
622
    points(frontier[idx.maxsr, mtc], frontier[idx.maxsr, mean.mtc], pch=16)
623
    # text(x=frontier[idx.maxsr], y=frontier[idx.maxsr], labels="T", pos=4, cex=0.8)
624
    # Add legend with max Risk adjusted Return ratio and risk-free rate
625
    legend("topleft", paste(RAR.text, " = ", signif(srmax,3), sep = ""), bty = "n", cex=cex.legend)
626
    legend("topleft", inset = c(0,0.05), paste("rf = ", signif(rf,3), sep = ""), bty = "n", cex=cex.legend)
627
  }
628
  axis(1, cex.axis = cex.axis, col = element.color)
629
  axis(2, cex.axis = cex.axis, col = element.color)
630
  box(col = element.color)
631
}
632

633
#' Plot multiple efficient frontiers
634
#' 
635
#' Overlay the efficient frontiers of multiple portfolio objects on a single plot.
636
#' 
637
#' @param R an xts object of asset returns
638
#' @param portfolio_list list of portfolio objects created by 
639
#' \code{\link{portfolio.spec}} and combined with \code{\link{combine.portfolios}}
640
#' @param type type of efficient frontier, see \code{\link{create.EfficientFrontier}}
641
#' @param n.portfolios number of portfolios to extract along the efficient frontier.
642
#' This is only used for objects of class \code{optimize.portfolio}
643
#' @param match.col string name of column to use for risk (horizontal axis).
644
#' Must match the name of an objective.
645
#' @param search_size passed to optimize.portfolio for type="DEoptim" or type="random".
646
#' @param main title used in the plot.
647
#' @param cex.axis the magnification to be used for sizing the axis text relative to the current setting of 'cex', similar to \code{\link{plot}}.
648
#' @param element.color provides the color for drawing less-important chart elements, such as the box lines, axis lines, etc.
649
#' @param legend.loc location of the legend; NULL, "bottomright", "bottom", "bottomleft", "left", "topleft", "top", "topright", "right" and "center".
650
#' @param legend.labels character vector to use for the legend labels.
651
#' @param cex.legend The magnification to be used for sizing the legend relative to the current setting of 'cex', similar to \code{\link{plot}}.
652
#' @param xlim set the x-axis limit, same as in \code{\link{plot}}.
653
#' @param ylim set the y-axis limit, same as in \code{\link{plot}}.
654
#' @param \dots passthrough parameters to \code{\link{plot}}.
655
#' @param chart.assets TRUE/FALSE to include the assets.
656
#' @param labels.assets TRUE/FALSE to include the asset names in the plot.
657
#' @param pch.assets plotting character of the assets, same as in \code{\link{plot}}.
658
#' @param cex.assets A numerical value giving the amount by which the asset points and labels should be magnified relative to the default.
659
#' @param col vector of colors with length equal to the number of portfolios in \code{portfolio_list}.
660
#' @param lty vector of line types with length equal to the number of portfolios in \code{portfolio_list}.
661
#' @param lwd vector of line widths with length equal to the number of portfolios in \code{portfolio_list}.
662
#' @author Ross Bennett
663
#' @export
664
chart.EfficientFrontierOverlay <- function(R, portfolio_list, type, n.portfolios=25, match.col="ES", search_size=2000, main="Efficient Frontiers", cex.axis=0.8, element.color="darkgray", legend.loc=NULL, legend.labels=NULL, cex.legend=0.8, xlim=NULL, ylim=NULL, ..., chart.assets=TRUE, labels.assets=TRUE, pch.assets=21, cex.assets=0.8, col=NULL, lty=NULL, lwd=NULL){
665
  # create multiple efficient frontier objects (one per portfolio in portfolio_list)
666
  if(!inherits(portfolio_list, "portfolio.list")) stop("portfolio_list must be passed in as a list")
667
  if(length(portfolio_list) == 1) warning("Only one portfolio object in portfolio_list")
668
  # store in out
669
  out <- list()
670
  for(i in 1:length(portfolio_list)){
671
    if(!is.portfolio(portfolio_list[[i]])) stop("portfolio in portfolio_list must be of class 'portfolio'")
672
    out[[i]] <- create.EfficientFrontier(R=R, portfolio=portfolio_list[[i]], type=type, n.portfolios=n.portfolios, match.col=match.col, search_size=search_size)
673
  }
674
  # get the data to plot scatter of asset returns
675
  asset_ret <- scatterFUN(R=R, FUN="mean")
676
  asset_risk <- scatterFUN(R=R, FUN=match.col)
677
  rnames <- colnames(R)
678
  
679
  # set the x and y limits
680
  if(is.null(xlim)){
681
    xlim <- range(asset_risk)
682
    # xlim[1] <- xlim[1] * 0.8
683
    xlim[1] <- 0
684
    xlim[2] <- xlim[2] * 1.15
685
  }
686
  if(is.null(ylim)){
687
    ylim <- range(asset_ret)
688
    # ylim[1] <- ylim[1] * 0.9
689
    ylim[1] <- 0
690
    ylim[2] <- ylim[2] * 1.1
691
  }
692
  
693
  # plot the assets
694
  plot(x=asset_risk, y=asset_ret, xlab=match.col, ylab="Mean", main=main, xlim=xlim, ylim=ylim, axes=FALSE, type="n", ...)
695
  axis(1, cex.axis = cex.axis, col = element.color)
696
  axis(2, cex.axis = cex.axis, col = element.color)
697
  box(col = element.color)
698
  
699
  if(chart.assets){
700
    # risk-return scatter of the assets
701
    points(x=asset_risk, y=asset_ret, pch=pch.assets, cex=cex.assets)
702
    if(labels.assets) text(x=asset_risk, y=asset_ret, labels=rnames, pos=4, cex=cex.assets)
703
  }
704
  
705
  # set some basic plot parameters
706
  if(is.null(col)) col <- 1:length(out)
707
  if(is.null(lty)) lty <- 1:length(out)
708
  if(is.null(lwd)) lwd <- rep(1, length(out))
709
  
710
  for(i in 1:length(out)){
711
    tmp <- out[[i]]
712
    tmpfrontier <- tmp$frontier
713
    cnames <- colnames(tmpfrontier)
714
    
715
    # get the "mean" column
716
    mean.mtc <- pmatch("mean", cnames)
717
    if(is.na(mean.mtc)) {
718
      mean.mtc <- pmatch("mean.mean", cnames)
719
    }
720
    if(is.na(mean.mtc)) stop("could not match 'mean' with column name of extractStats output")
721
    
722
    # get the match.col column
723
    mtc <- pmatch(match.col, cnames)
724
    if(is.na(mtc)) {
725
      mtc <- pmatch(paste(match.col, match.col, sep='.'),cnames)
726
    }
727
    if(is.na(mtc)) stop("could not match match.col with column name of extractStats output")
728
    # Add the efficient frontier lines to the plot
729
    lines(x=tmpfrontier[, mtc], y=tmpfrontier[, mean.mtc], col=col[i], lty=lty[i], lwd=lwd[i])
730
  }
731
  if(!is.null(legend.loc)){
732
    if(is.null(legend.labels)){
733
      legend.labels <- paste("Portfolio", 1:length(out), sep=".")
734
    }
735
    legend(legend.loc, legend=legend.labels, col=col, lty=lty, lwd=lwd, cex=cex.legend, bty="n") 
736
  }
737
  return(invisible(out))
738
}
739

740

741
#' Overlay the efficient frontiers of different minRisk portfolio objects on a single plot.
742
#' 
743
#' @param R an xts object of asset returns
744
#' @param portfolio same constrained portfolio created by \code{\link{portfolio.spec}}
745
#' @param risk_type type of risk that you want to compare
746
#' @param n.portfolios number of portfolios to extract along the efficient frontier.
747
#' This is only used for objects of class \code{optimize.portfolio}
748
#' @param match.col string name of column to use for portfolio object.
749
#' Must match the name of an objective.
750
#' @param guideline show the risk difference and mean difference between efficient frontiers
751
#' @param plot_type define the plot_type, default is "l"
752
#' @param main title used in the plot.
753
#' @param cex.axis the magnification to be used for sizing the axis text relative to the current setting of 'cex', similar to \code{\link{plot}}.
754
#' @param element.color provides the color for drawing less-important chart elements, such as the box lines, axis lines, etc.
755
#' @param legend.loc location of the legend; NULL, "bottomright", "bottom", "bottomleft", "left", "topleft", "top", "topright", "right" and "center".
756
#' @param legend.labels character vector to use for the legend labels.
757
#' @param cex.legend The magnification to be used for sizing the legend relative to the current setting of 'cex', similar to \code{\link{plot}}.
758
#' @param xlim set the x-axis limit, same as in \code{\link{plot}}.
759
#' @param ylim set the y-axis limit, same as in \code{\link{plot}}.
760
#' @param \dots passthrough parameters to \code{\link{plot}}.
761
#' @param chart.assets TRUE/FALSE to include the assets.
762
#' @param labels.assets TRUE/FALSE to include the asset names in the plot.
763
#' @param pch.assets plotting character of the assets, same as in \code{\link{plot}}.
764
#' @param cex.assets A numerical value giving the amount by which the asset points and labels should be magnified relative to the default.
765
#' @param col vector of colors with length equal to the number of portfolios in \code{portfolio_list}. Add two more to customize guideline color.
766
#' @param lty vector of line types with length equal to the number of portfolios in \code{portfolio_list}. Add two more to customize guideline type.
767
#' @param lwd vector of line widths with length equal to the number of portfolios in \code{portfolio_list}. Add two more to customize guideline width.
768
#' @author Xinran Zhao
769
#' @export
770
chart.EfficientFrontierCompare <- function(R, portfolio, risk_type, n.portfolios=25, match.col=c("StdDev", "ES"), guideline=NULL, main="Efficient Frontiers", plot_type = "l", cex.axis=0.5, element.color="darkgray", legend.loc=NULL, legend.labels=NULL, cex.legend=0.8, xlim=NULL, ylim=NULL, ..., chart.assets=TRUE, labels.assets=TRUE, pch.assets=21, cex.assets=0.8, col=NULL, lty=NULL, lwd=NULL){
771
  # show digits
772
  options(scipen = 999)
773
  
774
  # store in out
775
  out <- create.EfficientFrontier(R=R, portfolio=portfolio, type="mean-risk", risk_type=risk_type, compare_port = match.col, n.portfolios = n.portfolios, ...)
776
  n.p = dim(out$frontier)[1]
777
  m.p = dim(out$frontier)[2]
778
  rnames <- colnames(R)
779
  
780
  # set the x and y limits
781
  if(is.null(xlim)){
782
    xlim <- c(0, 0)
783
    xlim[1] <- out$frontier[1,1] * 0.7
784
    xlim[2] <- out$frontier[n.p, 1] * 1.2
785
  }
786
  if(is.null(ylim)){
787
    ylim <- c(0, 0)
788
    ylim[1] <- out$frontier[1,2] * 0.7
789
    ylim[2] <- out$frontier[n.p, 2] * 1.2
790
  }
791
  
792
  # plot the assets
793
  plot(x=1, y=1, xlab=risk_type, ylab="Mean", main=main, xlim=xlim, ylim=ylim, axes=FALSE, type="n", ...)
794
  axis(1, cex.axis = cex.axis, col = element.color)
795
  axis(2, cex.axis = cex.axis, col = element.color)
796
  box(col = element.color)
797
  
798
  if(is.null(guideline)) guideline <- ifelse(length(match.col) == 2, TRUE, FALSE)
799
  if(guideline){
800
    # set some basic plot parameters
801
    if(is.null(col) | length(col) == length(match.col)) col <- c(1:length(match.col), 1, 1)
802
    if(is.null(lty) | length(lty) == length(match.col)) lty <- c(1:length(match.col), 3, 3)
803
    if(is.null(lwd) | length(lwd) == length(match.col)) lwd <- c(rep(1, length(match.col)), 1, 1)
804
  } else {
805
    if(is.null(col)) col <- 1:length(match.col)
806
    if(is.null(lty)) lty <- 1:length(match.col)
807
    if(is.null(lwd)) lwd <- rep(1, length(match.col))
808
  }
809
  
810
  # get the "mean" column
811
  cnames <- colnames(out$frontier)
812
  mean.mtc <- pmatch("mean", cnames)
813
  if(is.na(mean.mtc)) {
814
    mean.mtc <- pmatch("mean.mean", cnames)
815
  }
816
  if(is.na(mean.mtc)) stop("could not match 'mean' with column name of extractStats output")
817
  
818
  for(i in 1:length(match.col)){
819
    # get the match.col column
820
    mtc <- pmatch(match.col[i], cnames)
821
    if(is.na(mtc)) stop("could not match match.col with column name of extractStats output")
822
    # Add the efficient frontier lines to the plot
823
    lines(x=out$frontier[, mtc], y=out$frontier[, mean.mtc], col=col[i], lty=lty[i], lwd=lwd[i], type = plot_type, ...)
824
  }
825
  
826
  # legend
827
  if(!is.null(legend.loc)){
828
    legend.loc = "bottomright"
829
  }
830
  if(is.null(legend.labels)){
831
      legend.labels <- paste("min", match.col, "Portfolio")
832
  }
833
  if(guideline){
834
    lines(x=c(out$frontier[1,1], out$frontier[1,m.p]), y = rep(out$frontier[1,2], 2), lty=lty[3], col=col[3], lwd=lwd[3])
835
    points(x=c(out$frontier[1,1], out$frontier[1,m.p]), y = rep(out$frontier[1,2], 2), pch=pch.assets, cex=cex.assets)
836
    x_diff = abs(out$frontier[,1] - out$frontier[1,m.p])
837
    x_index = min(abs(out$frontier[,1] - out$frontier[1,m.p]))
838
    lines(x=c(out$frontier[which(x_diff == x_index),1], out$frontier[1,m.p]), y = c(out$frontier[which(x_diff == x_index),2], out$frontier[1,2]), lty=lty[4], col=col[4], lwd=lwd[4])
839
    points(x=c(out$frontier[which(x_diff == x_index),1], out$frontier[1,m.p]), y = c(out$frontier[which(x_diff == x_index),2], out$frontier[1,2]), pch=pch.assets, cex=cex.assets)
840
    if(labels.assets){
841
      text(out$frontier[1,1], out$frontier[1,2], labels = paste("(", round(out$frontier[1,1], 4), ",", round(out$frontier[1,2], 4), ")"), pos = 1, cex = cex.assets)
842
      text(out$frontier[1,m.p], out$frontier[1,2], labels = paste("(", round(out$frontier[1,m.p], 4), ",", round(out$frontier[1,2], 4), ")"), pos = 4, cex = cex.assets)
843
      text(out$frontier[which(x_diff == x_index),1], out$frontier[which(x_diff == x_index),2], labels = paste("(", round(out$frontier[which(x_diff == x_index),1], 4), ",", round(out$frontier[which(x_diff == x_index),2], 4), ")"), pos = 2, cex = cex.assets)
844
    }
845
    legend.labels <- append(legend.labels, paste("% Decrease in Risk =", round((out$frontier[1,m.p] - out$frontier[1,1]) * 100 / out$frontier[1,1], 2)))
846
    legend.labels <- append(legend.labels, paste("% Increase in Return =", round((out$frontier[which(x_diff == x_index),2] - out$frontier[1,2]) * 100 / out$frontier[1,2], 2)))
847
  }
848
  legend("bottomright", legend=legend.labels, col=col, lty=lty, lwd=lwd, cex=cex.legend, bty="n")
849
  return(invisible(out))
850
}
851

852
###############################################################################
853
# R (https://r-project.org/) Numeric Methods for Optimization of Portfolios
854
#
855
# Copyright (c) 2004-2023 Brian G. Peterson, Peter Carl, Ross Bennett, Kris Boudt, Xinran Zhao
856
#
857
# This library is distributed under the terms of the GNU Public License (GPL)
858
# for full details see the file COPYING
859
#
860
# $Id$
861
#
862
###############################################################################
863

864
Product

Resources

Company
