CoCalc -- extract.efficient.frontier.R

GitHub Repository: braverock/portfolioanalytics
Path: blob/master/R/extract.efficient.frontier.R
¹⁴³³ views
1
###############################################################################
2
# R (https://r-project.org/) Numeric Methods for Optimization of Portfolios
3
#
4
# Copyright (c) 2004-2023 Brian G. Peterson, Peter Carl, Ross Bennett, Kris Boudt, Xinran Zhao
5
#
6
# This library is distributed under the terms of the GNU Public License (GPL)
7
# for full details see the file COPYING
8
#
9
# $Id$
10
#
11
###############################################################################
12

13

14
extract.efficient.frontier <- function (object=NULL, match.col='ES', from=NULL, to=NULL, by=0.005, n.portfolios=NULL, ..., R=NULL, portfolio=NULL, optimize_method='random')
15
{
16
  #TODO add a threshold argument for how close it has to be to count
17
  # do we need to recalc the constrained_objective too?  I don't think so.
18
  if(!inherits(object, "optimize.portfolio")) stop("object passed in must of of class 'portfolio'")
19
  
20
  #set<-seq(from=from,to=to,by=by)
21
  #set<-cbind(quantmod::Lag(set,1),as.matrix(set))[-1,]
22
  if(is.null(object)){
23
    if(!is.null(R) & !is.null(portfolio)){
24
      portfolios<-optimize.portfolio(portfolio=portfolio, R=R, optimize_method=optimize_method[1], trace=TRUE, ...)
25
    } else {
26
      stop('you must specify a portfolio object and a return series or an objective of class optimize.portfolio')
27
    }
28
  }
29
  
30
  xtract<-extractStats(object)
31
  columnnames=colnames(xtract)
32
  # optimal portfolio stats from xtract
33
  opt <- xtract[which.min(xtract[, "out"]),]
34
  #if("package:multicore" %in% search() || requireNamespace("multicore",quietly = TRUE)){
35
  #    mclapply
36
  #}
37
  stopifnot("package:foreach" %in% search() || requireNamespace("foreach",quietly = TRUE))
38
  #    rtc = pmatch(return.col,columnnames)
39
  #    if(is.na(rtc)) {
40
  #        rtc = pmatch(paste(return.col,return.col,sep='.'),columnnames)
41
  #    }
42
  mtc = pmatch(match.col,columnnames)
43
  if(is.na(mtc)) {
44
    mtc = pmatch(paste(match.col,match.col,sep='.'),columnnames)
45
  }
46
  if(is.na(mtc)) stop("could not match match.col with column name of extractStats output")
47
  
48
  if(is.null(from)){
49
    from <- min(xtract[, mtc])
50
  }
51
  if(is.null(to)){
52
    to <- max(xtract[, mtc])
53
  }
54
  if(!is.null(n.portfolios)){
55
    # create the sequence using length.out if the user has specified a value for the n.portfolios arg
56
    set<-seq(from=from, to=to, length.out=n.portfolios)
57
  } else {
58
    # fall back to using by to create the sequence
59
    set<-seq(from=from, to=to, by=by)
60
  }
61
  
62
  set<-cbind(quantmod::Lag(set,1),as.matrix(set))[-1,]
63
  i <- 1
64
  result <- foreach::foreach(i=1:nrow(set),.inorder=TRUE, .combine=rbind, .errorhandling='remove') %do% {
65
    tmp<-xtract[which(xtract[,mtc]>=set[i,1] & xtract[,mtc]<set[i,2]),]
66
    #tmp<-tmp[which.min(tmp[,'out']),]
67
    tmp<-tmp[which.max(tmp[,'mean']),]
68
    #tmp
69
  }
70
  # combine the stats from the optimal portfolio to result matrix
71
  result <- rbind(opt, result)
72
  return(structure(result, class="frontier"))
73
}
74

75
#' Generate the efficient frontier for a mean-variance portfolio
76
#' 
77
#' This function generates the mean-variance efficient frontier of a portfolio
78
#' specifying the constraints and objectives. The \code{portfolio} object 
79
#' should have two objectives: 1) mean and 2) var (or sd or StdDev). If the 
80
#' portfolio object does not contain these objectives, they will be added 
81
#' using default parameters.
82
#' 
83
#' @param portfolio a portfolio object with constraints created via \code{\link{portfolio.spec}}
84
#' @param R an xts or matrix of asset returns
85
#' @param optimize_method the optimize method to get the efficient frontier, default is ROI
86
#' @param n.portfolios number of portfolios to plot along the efficient frontier
87
#' @param risk_aversion vector of risk_aversion values to construct the efficient frontier.
88
#' \code{n.portfolios} is ignored if \code{risk_aversion} is specified and the number
89
#' of points along the efficient frontier is equal to the length of \code{risk_aversion}.
90
#' @param \dots passthru parameters to \code{\link{optimize.portfolio}}
91
#' @return a matrix of objective measure values and weights along the efficient frontier
92
#' @author Ross Bennett
93
#' @export
94
meanvar.efficient.frontier <- function(portfolio, R, optimize_method='CVXR', n.portfolios=25, risk_aversion=NULL, ...){
95
  if(!is.portfolio(portfolio)) stop("portfolio object must be of class 'portfolio'")
96
  # step 1: find the minimum return given the constraints
97
  # step 2: find the maximum return given the constraints
98
  # step 3: 'step' along the returns and run the optimization to calculate
99
  # the weights and objective measures along the efficient frontier
100
  
101
  # Use the portfolio_risk_objective from the portfolio if they have it
102
  # check for a var, StdDev, or sd objective
103
  var_idx <- which(unlist(lapply(portfolio$objectives, function(x) x$name))  %in% c("var", "StdDev", "sd"))
104
  if(length(var_idx) >= 1){
105
    # the portfolio object has a var, StdDev, or sd objective
106
    var_obj <- portfolio$objectives[[var_idx[1]]]
107
  } else {
108
    var_obj <- portfolio_risk_objective(name="var")
109
  }
110
  
111
  hhi_idx <- which(unlist(lapply(portfolio$objectives, function(x) x$name))  == "HHI")
112
  if(length(hhi_idx) >= 1){
113
    # the portfolio object has an HHI objective
114
    hhi_obj <- portfolio$objectives[[hhi_idx[1]]]
115
  } else {
116
    hhi_obj <- NULL
117
  }
118
  
119
  # Clear out the objectives in portfolio and add them here to simplify checks
120
  # and so we can control the optimization along the efficient frontier.
121
  portfolio$objectives <- list()
122
  portfolio$objectives[[1]] <- var_obj
123
  portfolio$objectives[[2]] <- hhi_obj
124
  portfolio <- add.objective(portfolio=portfolio, type="return", name="mean")
125
  
126
  # If the user has passed in a portfolio object with return_constraint, we need to disable it
127
  for(i in 1:length(portfolio$constraints)){
128
    if(inherits(portfolio$constraints[[i]], "return_constraint")){
129
      portfolio$constraints[[i]]$enabled <- FALSE
130
    }
131
  }
132
  
133
  # get the index number of the var objective 
134
  var_idx <- which(unlist(lapply(portfolio$objectives, function(x) x$name))  %in% c("var", "StdDev", "sd"))
135
  # get the index number of the mean objective
136
  mean_idx <- which(unlist(lapply(portfolio$objectives, function(x) x$name)) == "mean")
137
  # get the index number of the hhi objective
138
  hhi_idx <- which(unlist(lapply(portfolio$objectives, function(x) x$name)) == "HHI")
139
  
140
  ##### get the maximum return #####
141
  
142
  # Disable the risk objective and hhi objective if applicable
143
  portfolio$objectives[[var_idx]]$enabled <- FALSE
144
  if(length(hhi_idx) >= 1) portfolio$objectives[[hhi_idx]]$enabled <- FALSE
145
  
146
  # run the optimization to get the maximum return
147
  tmp <- optimize.portfolio(R=R, portfolio=portfolio, optimize_method=optimize_method, ...=...)
148
  mean_ret <- colMeans(R)
149
  maxret <- extract_risk(R, tmp$weights)$mean
150
  
151
  ##### Get the return at the minimum variance portfolio #####
152
  
153
  # Disable the return objective
154
  portfolio$objectives[[mean_idx]]$enabled <- FALSE
155
  
156
  # Enable the risk objective and hhi objective if applicable
157
  portfolio$objectives[[var_idx]]$enabled <- TRUE
158
  if(length(hhi_idx) >= 1) portfolio$objectives[[hhi_idx]]$enabled <- TRUE
159
  
160
  # Run the optimization to get the global minimum variance portfolio with the
161
  # given constraints.
162
  # Do we want to disable the turnover or transaction costs constraints here?
163
  tmp <- optimize.portfolio(R=R, portfolio=portfolio, optimize_method=optimize_method, ...=...)
164
  stats <- extractStats(tmp)
165
  minret <- extract_risk(R, tmp$weights)$mean
166
  
167
  # length.out is the number of portfolios to create
168
  ret_seq <- seq(from=minret, to=maxret, length.out=n.portfolios)
169
  
170
  # Add target return constraint to step along the efficient frontier for target returns
171
  portfolio <- add.constraint(portfolio=portfolio, type="return", return_target=minret, enabled=FALSE)
172
  ret_constr_idx <- which(unlist(lapply(portfolio$constraints, function(x) inherits(x, "return_constraint"))))
173
  
174
  stopifnot("package:foreach" %in% search() || requireNamespace("foreach",quietly = TRUE))
175
  stopifnot("package:iterators" %in% search() || requireNamespace("iterators",quietly = TRUE))
176
  if(!is.null(risk_aversion)){
177
    # Enable the return objective so we are doing quadratic utility
178
    portfolio$objectives[[mean_idx]]$enabled <- TRUE
179
    lambda <- risk_aversion[1]
180
    out <- foreach::foreach(lambda=iterators::iter(risk_aversion), .inorder=TRUE, .combine=rbind, .errorhandling='remove', .packages='PortfolioAnalytics') %dopar% {
181
      portfolio$objectives[[var_idx]]$risk_aversion <- lambda
182
      extractStats(optimize.portfolio(R=R, portfolio=portfolio, optimize_method=optimize_method, ...=...))
183
    }
184
    out <- cbind(out, risk_aversion)
185
    colnames(out) <- c(names(stats), "lambda")
186
  } else {
187
    # Enable the return constraint
188
    portfolio$constraints[[ret_constr_idx]]$enabled <- TRUE
189
    ret <- ret_seq[1]
190
    out <- foreach::foreach(ret=iterators::iter(ret_seq), .inorder=TRUE, .combine=rbind, .errorhandling='remove', .packages='PortfolioAnalytics') %dopar% {
191
      portfolio$constraints[[ret_constr_idx]]$return_target <- ret
192
      opt <- optimize.portfolio(R=R, portfolio=portfolio, optimize_method=optimize_method, ...=...)
193
      c(sum(extractWeights(opt) * mean_ret), extractStats(opt))
194
    }
195
    colnames(out) <- c("mean", names(stats))
196
  }
197
  out <- na.omit(out)
198
  return(structure(out, class="frontier"))
199
}
200

201
#' Generate the efficient frontier for a mean-etl portfolio
202
#' 
203
#' This function generates the mean-ETL efficient frontier of a portfolio
204
#' specifying the constraints and objectives. The \code{portfolio} object 
205
#' should have two objectives: 1) mean and 2) ES (or ETL or cVaR). If the 
206
#' portfolio object does not contain these objectives, they will be added 
207
#' using default parameters.
208
#' 
209
#' @param portfolio a portfolio object with constraints and objectives created via \code{\link{portfolio.spec}}
210
#' @param R an xts or matrix of asset returns
211
#' @param optimize_method the optimize method to get the efficient frontier, default is ROI
212
#' @param n.portfolios number of portfolios to generate the efficient frontier
213
#' @param \dots passthru parameters to \code{\link{optimize.portfolio}}
214
#' @return a matrix of objective measure values and weights along the efficient frontier
215
#' @author Ross Bennett
216
#' @export
217
meanetl.efficient.frontier <- meanes.efficient.frontier <- function(portfolio, R, optimize_method='CVXR', n.portfolios=25, ...){
218
  if(!is.portfolio(portfolio)) stop("portfolio object must be of class 'portfolio'")
219
  # step 1: find the minimum return given the constraints
220
  # step 2: find the maximum return given the constraints
221
  # step 3: 'step' along the returns and run the optimization to calculate
222
  # the weights and objective measures along the efficient frontier
223
  
224
  # Use the portfolio_risk_objective from the portfolio if they have it
225
  # check for a ETL, ES, or cVaR objective
226
  etl_idx <- which(unlist(lapply(portfolio$objectives, function(x) x$name))  %in% c("ETL", "ES", "CVaR"))
227
  if(length(etl_idx) >= 1){
228
    # the portfolio object has a ETL, ES, CVaR objective
229
    etl_obj <- portfolio$objectives[[etl_idx[1]]]
230
  } else {
231
    etl_obj <- portfolio_risk_objective(name="ES", arguments=list(p=0.95))
232
  }
233
  
234
  # Clear out the objectives in portfolio and add them here to simplify checks
235
  # and so we can control the optimization along the efficient frontier.
236
  portfolio$objectives <- list()
237
  portfolio$objectives[[1]] <- etl_obj
238
  portfolio <- add.objective(portfolio=portfolio, type="return", name="mean")
239
  
240
  # get the objective names from the portfolio object
241
  objnames <- unlist(lapply(portfolio$objectives, function(x) x$name))
242
  
243
  # If the user has passed in a portfolio object with return_constraint, we need to disable it
244
  for(i in 1:length(portfolio$constraints)){
245
    if(inherits(portfolio$constraints[[i]], "return_constraint")){
246
      portfolio$constraints[[i]]$enabled <- FALSE
247
    }
248
  }
249
  
250
  # get the index number of the etl objective
251
  etl_idx <- which(objnames %in% c("ETL", "ES", "CVaR"))
252
  # get the index number of the mean objective
253
  mean_idx <- which(objnames == "mean")
254
  
255
  # create a temporary portfolio to find the max mean return
256
  ret_obj <- return_objective(name="mean")
257
  tportf <- insert_objectives(portfolio, list(ret_obj))
258
  
259
  # run the optimization to get the maximum return
260
  tmp <- optimize.portfolio(R=R, portfolio=tportf, optimize_method=optimize_method, ...)
261
  maxret <- extractObjectiveMeasures(tmp)$mean
262
  
263
  # run the optimization to get the return at the min ETL portfolio
264
  tmp <- optimize.portfolio(R=R, portfolio=portfolio, optimize_method=optimize_method, ef=TRUE, ...)
265
  stats <- extractStats(tmp)
266
  minret <- stats["mean"]
267
  
268
  # length.out is the number of portfolios to create
269
  ret_seq <- seq(from=minret, to=maxret, length.out=n.portfolios)
270
  
271
  #   out <- matrix(0, nrow=length(ret_seq), ncol=length(extractStats(tmp)))
272
  #   for(i in 1:length(ret_seq)){
273
  #     portfolio$objectives[[mean_idx]]$target <- ret_seq[i]
274
  #     out[i, ] <- extractStats(optimize.portfolio(R=R, portfolio=portfolio, optimize_method="ROI"))
275
  #   }
276
  stopifnot("package:foreach" %in% search() || requireNamespace("foreach",quietly = TRUE))
277
  stopifnot("package:iterators" %in% search() || requireNamespace("iterators",quietly = TRUE))
278
  ret <- ret_seq[1]
279
  out <- foreach::foreach(ret=iterators::iter(ret_seq), .inorder=TRUE, .combine=rbind, .errorhandling='remove', .packages='PortfolioAnalytics') %dopar% {
280
    portfolio$objectives[[mean_idx]]$target <- ret
281
    extractStats(optimize.portfolio(R=R, portfolio=portfolio, optimize_method=optimize_method, ef=TRUE, ...=...))
282
  }
283
  colnames(out) <- names(stats)
284
  out <- na.omit(out)
285
  return(structure(out, class="frontier"))
286
}
287

288
#' Generate the efficient frontier for a mean-CSM portfolio
289
#' 
290
#' This function generates the mean-CSM efficient frontier of a portfolio
291
#' specifying the constraints and objectives. The \code{portfolio} object 
292
#' should have two objectives: 1) mean and 2) CSM. If the 
293
#' portfolio object does not contain these objectives, they will be added 
294
#' using default parameters.
295
#' 
296
#' @param portfolio a portfolio object with constraints and objectives created via \code{\link{portfolio.spec}}
297
#' @param R an xts or matrix of asset returns
298
#' @param optimize_method the optimize method to get the efficient frontier, default is CVXR
299
#' @param n.portfolios number of portfolios to generate the efficient frontier
300
#' @param \dots passthru parameters to \code{\link{optimize.portfolio}}
301
#' @return a matrix of objective measure values and weights along the efficient frontier
302
#' @author Xinran Zhao
303
#' @export
304
meancsm.efficient.frontier <- function(portfolio, R, optimize_method='CVXR', n.portfolios=25, ...){
305
  if(!is.portfolio(portfolio)) stop("portfolio object must be of class 'portfolio'")
306
  # step 1: find the minimum return given the constraints
307
  # step 2: find the maximum return given the constraints
308
  # step 3: 'step' along the returns and run the optimization to calculate
309
  # the weights and objective measures along the efficient frontier
310
  
311
  # Use the portfolio_risk_objective from the portfolio if they have it
312
  # check for a ETL, ES, or cVaR objective
313
  CSM_idx <- which(unlist(lapply(portfolio$objectives, function(x) x$name)) == "CSM")
314
  if(length(CSM_idx) >= 1){
315
    # the portfolio object has a ETL, ES, CVaR objective
316
    CSM_obj <- portfolio$objectives[[CSM_idx[1]]]
317
  } else {
318
    CSM_obj <- portfolio_risk_objective(name="CSM", arguments=list(p=0.95))
319
  }
320
  
321
  # Clear out the objectives in portfolio and add them here to simplify checks
322
  # and so we can control the optimization along the efficient frontier.
323
  portfolio$objectives <- list()
324
  portfolio$objectives[[1]] <- CSM_obj
325
  portfolio <- add.objective(portfolio=portfolio, type="return", name="mean")
326
  
327
  # get the objective names from the portfolio object
328
  objnames <- unlist(lapply(portfolio$objectives, function(x) x$name))
329
  
330
  # If the user has passed in a portfolio object with return_constraint, we need to disable it
331
  for(i in 1:length(portfolio$constraints)){
332
    if(inherits(portfolio$constraints[[i]], "return_constraint")){
333
      portfolio$constraints[[i]]$enabled <- FALSE
334
    }
335
  }
336
  
337
  # get the index number of the CSM objective
338
  CSM_idx <- which(objnames == "CSM")
339
  # get the index number of the mean objective
340
  mean_idx <- which(objnames == "mean")
341
  
342
  # create a temporary portfolio to find the max mean return
343
  ret_obj <- return_objective(name="mean")
344
  tportf <- insert_objectives(portfolio, list(ret_obj))
345
  
346
  # run the optimization to get the maximum return
347
  tmp <- optimize.portfolio(R=R, portfolio=tportf, optimize_method=optimize_method, ...)
348
  maxret <- extractObjectiveMeasures(tmp)$mean
349
  
350
  # run the optimization to get the return at the min ETL portfolio
351
  tmp <- optimize.portfolio(R=R, portfolio=portfolio, optimize_method=optimize_method, ef=TRUE, ...)
352
  stats <- extractStats(tmp)
353
  minret <- stats["mean"]
354
  
355
  # length.out is the number of portfolios to create
356
  ret_seq <- seq(from=minret, to=maxret, length.out=n.portfolios)
357
  
358
  stopifnot("package:foreach" %in% search() || requireNamespace("foreach",quietly = TRUE))
359
  stopifnot("package:iterators" %in% search() || requireNamespace("iterators",quietly = TRUE))
360
  ret <- ret_seq[1]
361
  out <- foreach::foreach(ret=iterators::iter(ret_seq), .inorder=TRUE, .combine=rbind, .errorhandling='remove', .packages='PortfolioAnalytics') %dopar% {
362
    portfolio$objectives[[mean_idx]]$target <- ret
363
    extractStats(optimize.portfolio(R=R, portfolio=portfolio, optimize_method=optimize_method, ef=TRUE, ...=...))
364
  }
365
  colnames(out) <- names(stats)
366
  out <- na.omit(out)
367
  return(structure(out, class="frontier"))
368
}
369

370
#' Generate multiple efficient frontiers for the same portfolio
371
#' 
372
#' This function generates the mean-risk efficient frontier of a portfolio
373
#' specifying the constraints and objectives. The \code{risk_type} object 
374
#' is for the basic mean-risk efficient frontier, other efficient frontiers
375
#' will be generated with the same target returns. All mean-StdDev, mean-ES
376
#' and mean-CSM efficient frontiers will be generated.
377
#' 
378
#' @param portfolio a portfolio object with constraints and objectives created via \code{\link{portfolio.spec}}
379
#' @param R an xts or matrix of asset returns
380
#' @param optimize_method the optimize method to get the efficient frontier, default is CVXR
381
#' @param n.portfolios number of portfolios to generate the efficient frontier
382
#' @param risk_type one of "StdDev", "ES" and "CSM", which determines the type of basic efficient frontier.
383
#' @param compare_port vector composed of any risk "StdDev", "ES", "CSM", for example, compare_port=c("StdDev", "ES")
384
#' @param \dots passthru parameters to \code{\link{optimize.portfolio}}
385
#' @return a matrix of objective measure values and weights along the efficient frontier
386
#' @author Xinran Zhao
387
#' @export
388
meanrisk.efficient.frontier <- function(portfolio, R, optimize_method='CVXR', n.portfolios=25, risk_type="StdDev", compare_port = c("StdDev", "ES"),...){
389
  if(!is.portfolio(portfolio)) stop("portfolio object must be of class 'portfolio'")
390
  # step 1: mean-StdDev efficient frontier
391
  # step 2: calculate minimum ES with target return
392
  
393
  risk_compare <- compare_port[-which(compare_port == risk_type)]
394
  
395
  # Use the portfolio_risk_objective from the portfolio if they have it
396
  risk_idx <- which(unlist(lapply(portfolio$objectives, function(x) x$name)) == risk_type)
397
  if(length(risk_idx) >= 1){
398
    risk_obj <- portfolio$objectives[[risk_idx[1]]]
399
  } else {
400
    risk_obj <- portfolio_risk_objective(name=risk_type, arguments=list(p=0.05))
401
  }
402
  alpha <- ifelse(is.numeric(risk_obj$arguments$p), risk_obj$arguments$p, 0.05)
403
  if(alpha > 0.5) alpha <- (1 - alpha)
404
  
405
  # Clear out the objectives in portfolio and add them here to simplify checks
406
  # and so we can control the optimization along the efficient frontier.
407
  portfolio$objectives <- list()
408
  portfolio$objectives[[1]] <- risk_obj
409
  portfolio <- add.objective(portfolio=portfolio, type="return", name="mean")
410
  
411
  # get the objective names from the portfolio object
412
  objnames <- unlist(lapply(portfolio$objectives, function(x) x$name))
413
  
414
  # If the user has passed in a portfolio object with return_constraint, we need to disable it
415
  for(i in 1:length(portfolio$constraints)){
416
    if(inherits(portfolio$constraints[[i]], "return_constraint")){
417
      portfolio$constraints[[i]]$enabled <- FALSE
418
    }
419
  }
420
  
421
  # get the index number of the risk objective
422
  risk_idx <- which(objnames == risk_type)
423
  # get the index number of the mean objective
424
  mean_idx <- which(objnames == "mean")
425
  
426
  # create a temporary portfolio to find the max mean return
427
  ret_obj <- return_objective(name="mean")
428
  tportf <- insert_objectives(portfolio, list(ret_obj))
429
  
430
  # run the optimization to get the maximum return
431
  tmp <- optimize.portfolio(R=R, portfolio=tportf, optimize_method=optimize_method, ...)
432
  maxret <- extractObjectiveMeasures(tmp)$mean
433
  
434
  # run the optimization to get the return at the min ETL portfolio
435
  tmp <- optimize.portfolio(R=R, portfolio=portfolio, optimize_method=optimize_method, ef=TRUE, ...)
436
  stats <- extractStats(tmp)
437
  minret <- stats["mean"]
438
  
439
  # length.out is the number of portfolios to create
440
  ret_seq <- seq(from=minret, to=maxret, length.out=n.portfolios)
441
  
442
  stopifnot("package:foreach" %in% search() || requireNamespace("foreach",quietly = TRUE))
443
  stopifnot("package:iterators" %in% search() || requireNamespace("iterators",quietly = TRUE))
444
  ret <- ret_seq[1]
445
  out <- foreach::foreach(ret=iterators::iter(ret_seq), .inorder=TRUE, .combine=rbind, .errorhandling='remove', .packages='PortfolioAnalytics') %dopar% {
446
    portfolio$objectives[[mean_idx]]$target <- ret
447
    res <- extractStats(optimize.portfolio(R=R, portfolio=portfolio, optimize_method=optimize_method, ef=TRUE, ...=...))
448
    for(rc in risk_compare){
449
      tmpportfolio <- portfolio
450
      tmpportfolio$objectives[[risk_idx]]$name <- rc
451
      tmpw <- optimize.portfolio(R=R, portfolio=tmpportfolio, optimize_method=optimize_method, ef=TRUE, ...=...)$weight
452
      res <- append(res, extract_risk(R=R, w = tmpw, ES_alpha = alpha, CSM_alpha = alpha)[[risk_type]])
453
    }
454
    res
455
  }
456
  colnames(out) <- c(names(stats), paste(risk_compare, 'portfolio', risk_type))
457
  out <- na.omit(out)
458
  return(structure(out, class="frontier"))
459
}
460

461
#' create an efficient frontier
462
#' 
463
#' @details Currently there are 4 'types' supported to create an efficient frontier:
464
#' \describe{
465
#'   \item{"mean-var", "mean-sd", or "mean-StdDev":}{ This is a special case for 
466
#'   an efficient frontier that can be created by a QP solver.
467
#'   The \code{portfolio} object should have two
468
#'   objectives: 1) mean and 2) var. If the portfolio object does not contain these 
469
#'   objectives, they will be added using default parameters.
470
#'   The efficient frontier will be created via
471
#'   \code{\link{meanvar.efficient.frontier}}.}
472
#'   \item{"mean-ETL", "mean-ES", "mean-CVaR", "mean-etl":}{ This is a special 
473
#'   case for an efficient frontier that can be created by an LP solver.
474
#'   The \code{portfolio} object should have two objectives: 1) mean
475
#'   and 2) ETL/ES/CVaR. If the portfolio object does not contain these 
476
#'   objectives, they will be added using default parameters.
477
#'   The efficient frontier is created via 
478
#'   \code{\link{meanetl.efficient.frontier}}.}
479
#'   \item{"mean-CSM":}{ This is a special 
480
#'   case for an efficient frontier that can be created by CVXR solvers.
481
#'   The \code{portfolio} object should have two objectives: 1) mean
482
#'   and 2) CSM. If the portfolio object does not contain these 
483
#'   objectives, they will be added using default parameters.
484
#'   The efficient frontier is created via 
485
#'   \code{\link{meanrisk.efficient.frontier}}.}
486
#'   \item{"mean-risk":}{ This is a special case for multiple efficient frontiers.
487
#'   The efficient frontier is created via 
488
#'   \code{\link{meanrisk.efficient.frontier}}.}
489
#'   \item{"DEoptim":}{ This can handle more complex constraints and objectives
490
#'   than the simple mean-var and mean-ETL cases. For this type, we actually 
491
#'   call \code{\link{optimize.portfolio}} with \code{optimize_method="DEoptim"}
492
#'   and then extract the efficient frontier with 
493
#'   \code{extract.efficient.frontier}.}
494
#'   \item{"random":}{ This can handle more complex constraints and objectives
495
#'   than the simple mean-var and mean-ETL cases. For this type, we actually 
496
#'   call \code{\link{optimize.portfolio}} with \code{optimize_method="random"}
497
#'   and then extract the efficient frontier with 
498
#'   \code{extract.efficient.frontier}.}
499
#' }
500
#' 
501
#' @param R xts object of asset returns
502
#' @param portfolio object of class 'portfolio' specifying the constraints and objectives, see \code{\link{portfolio.spec}}.
503
#' @param type type of efficient frontier, see Details.
504
#' @param optimize_method the optimize method to get the efficient frontier, default is CVXR
505
#' @param n.portfolios number of portfolios to calculate along the efficient frontier
506
#' @param risk_aversion vector of risk_aversion values to construct the efficient frontier.
507
#' \code{n.portfolios} is ignored if \code{risk_aversion} is specified and the number
508
#' of points along the efficient frontier will be equal to the length of \code{risk_aversion}.
509
#' @param match.col column to match when extracting the efficient frontier from an objected created by \code{\link{optimize.portfolio}}.
510
#' @param search_size passed to \code{\link{optimize.portfolio}} for type="DEoptim" or type="random".
511
#' @param \dots passthrough parameters to \code{\link{optimize.portfolio}}.
512
#' @return an object of class 'efficient.frontier' with the objective measures 
513
#' and weights of portfolios along the efficient frontier.
514
#' @author Ross Bennett, Xinran Zhao
515
#' @seealso \code{\link{optimize.portfolio}}, 
516
#' \code{\link{portfolio.spec}}, 
517
#' \code{\link{meanvar.efficient.frontier}}, 
518
#' \code{\link{meanetl.efficient.frontier}}
519
#' @export
520
create.EfficientFrontier <- function(R, portfolio, type, optimize_method = 'CVXR', n.portfolios=25, risk_aversion=NULL, match.col="ES", search_size=2000, ...){
521
  # This is just a wrapper around a few functions to easily create efficient frontiers
522
  # given a portfolio object and other parameters
523
  call <- match.call()
524
  if(!is.portfolio(portfolio)) stop("portfolio must be of class 'portfolio'")
525
  type <- type[1]
526
  switch(type,
527
         "mean-sd"=,
528
         "mean-StdDev"=,
529
         "mean-var" = {frontier <- meanvar.efficient.frontier(portfolio=portfolio,
530
                                                              R=R, 
531
                                                              n.portfolios=n.portfolios,
532
                                                              risk_aversion=risk_aversion,
533
                                                              ...=...)
534
         },
535
         "mean-ETL"=,
536
         "mean-CVaR"=,
537
         "mean-ES"=,
538
         "mean-es"=,
539
         "mean-etl" = {frontier <- meanetl.efficient.frontier(portfolio=portfolio, 
540
                                                              R=R, 
541
                                                              n.portfolios=n.portfolios,
542
                                                              ...=...)
543
         },
544
         "mean-CSM"=,
545
         "mean-CSM" = {frontier <- meancsm.efficient.frontier(portfolio=portfolio,
546
                                                              R=R,
547
                                                              n.portfolios=n.portfolios,
548
                                                              ...=...)
549
         },
550
         "mean-risk" = {frontier <- meanrisk.efficient.frontier(portfolio=portfolio,
551
                                                                R=R,
552
                                                                n.portfolios=n.portfolios,
553
                                                                ...=...)
554
         },
555
         "random" = {tmp <- optimize.portfolio(R=R, 
556
                                               portfolio=portfolio, 
557
                                               optimize_method=type, 
558
                                               trace=TRUE, 
559
                                               search_size=search_size,
560
                                               ...=...)
561
                     frontier <- extract.efficient.frontier(object=tmp, 
562
                                                            match.col=match.col, 
563
                                                            n.portfolios=n.portfolios)
564
         },
565
         "DEoptim" = {tmp <- optimize.portfolio(R=R, 
566
                                                portfolio=portfolio, 
567
                                                optimize_method=type, 
568
                                                trace=TRUE, 
569
                                                search_size=search_size,
570
                                                ...=...)
571
                      frontier <- extract.efficient.frontier(object=tmp, 
572
                                                             match.col=match.col, 
573
                                                             n.portfolios=n.portfolios)
574
         }
575
  )
576
  return(structure(list(call=call,
577
                        frontier=frontier,
578
                        R=R,
579
                        portfolio=portfolio), class="efficient.frontier"))
580
}
581

582
#' Extract the efficient frontier data points
583
#' 
584
#' This function extracts the efficient frontier from an object created by
585
#' \code{\link{optimize.portfolio}}.
586
#' 
587
#' If the object is an \code{optimize.portfolio.ROI} object and \code{match.col}
588
#'  is "ES", "ETL", or "CVaR", then the mean-ETL efficient frontier will be 
589
#'  created via \code{meanetl.efficient.frontier}. 
590
#' 
591
#' If the object is an \code{optimize.portfolio.ROI} object and \code{match.col}
592
#'  is "StdDev", then the mean-StdDev efficient frontier will be created via 
593
#' \code{meanvar.efficient.frontier}. Note that if 'var' is specified as the
594
#' name of an objective, the value returned will be 'StdDev'.
595
#' 
596
#' For objects created by \code{optimize.portfolo} with the DEoptim, random, or
597
#' pso solvers, the efficient frontier will be extracted from the object via
598
#' \code{extract.efficient.frontier}. This means that \code{optimize.portfolio} must
599
#' be run with \code{trace=TRUE}.
600
#' 
601
#' @param object an optimal portfolio object created by \code{optimize.portfolio}
602
#' @param match.col string name of column to use for risk (horizontal axis).
603
#' \code{match.col} must match the name of an objective measure in the 
604
#' \code{objective_measures} or \code{opt_values} slot in the object created 
605
#' by \code{\link{optimize.portfolio}}.
606
#' @param n.portfolios number of portfolios to use to plot the efficient frontier
607
#' @param risk_aversion vector of risk_aversion values to construct the efficient frontier.
608
#' \code{n.portfolios} is ignored if \code{risk_aversion} is specified and the number
609
#' of points along the efficient frontier is equal to the length of \code{risk_aversion}.
610
#' @return an \code{efficient.frontier} object with weights and other metrics along the efficient frontier
611
#' @author Ross Bennett
612
#' @export
613
extractEfficientFrontier <- function(object, match.col="ES", n.portfolios=25, risk_aversion=NULL){
614
  # extract the efficient frontier from an optimize.portfolio output object
615
  call <- match.call()
616
  if(!inherits(object, "optimize.portfolio")) stop("object must be of class 'optimize.portfolio'")
617
  
618
  if(inherits(object, "optimize.portfolio.GenSA")){
619
    stop("GenSA does not return any useable trace information for portfolios tested, thus we cannot extract an efficient frontier.")
620
  }
621
  
622
  # get the portfolio and returns 
623
  portf <- object$portfolio
624
  R <- object$R
625
  if(is.null(R)) stop(paste("Not able to get asset returns from", object, "run optimize.portfolio with trace=TRUE"))
626
  
627
  # get the objective names and check if match.col is an objective name
628
  # objnames <- unlist(lapply(portf$objectives, function(x) x$name))
629
  # if(!(match.col %in% objnames)){
630
  #   stop("match.col must match an objective name")
631
  # }
632
  
633
  # We need to create the efficient frontier if object is of class optimize.portfolio.ROI
634
  if(inherits(object, "optimize.portfolio.ROI")){
635
    if(match.col %in% c("ETL", "ES", "CVaR")){
636
      frontier <- meanetl.efficient.frontier(portfolio=portf, R=R, n.portfolios=n.portfolios)
637
    }
638
    if(match.col == "StdDev"){
639
      frontier <- meanvar.efficient.frontier(portfolio=portf, R=R, n.portfolios=n.portfolios, risk_aversion=risk_aversion)
640
    }
641
  } # end optimize.portfolio.ROI
642
  
643
  # use extract.efficient.frontier for otpimize.portfolio output objects with global solvers
644
  if(inherits(object, c("optimize.portfolio.random", "optimize.portfolio.DEoptim", "optimize.portfolio.pso"))){
645
    frontier <- extract.efficient.frontier(object=object, match.col=match.col, n.portfolios=n.portfolios)
646
  }
647
  return(structure(list(call=call,
648
                        frontier=frontier,
649
                        R=R,
650
                        portfolio=portf), class="efficient.frontier"))
651
}
652

653

654
Product

Resources

Company
