R/mvef_portfolio.R

In rengelke/quantTraiding_trato: Trading Strategies Development Tool Kit

#' Calculates the Mean Variance Efficient Frontier for a Risk Adjusted Portfolio
#'
#' @param R xts tavle with asset returns
#' @param short Short trading possible: "yes", "no"
#' @param max_allocation Maximum asset position allocation
#' @param risk_premium_up Upper limit of the premium risk modelled
#' @param risk_increment Increment value for risk modelling
#'
#' @return ???Data frame with efficient frontier
#' @import corpcor
#' @import quadprog
#' @export mvef_portfolio
#'
#' @examples eff <- mvef_portfolio(R = returns_set, short = "no",
#' @examples max_allocation = 0.4, risk_premium_up = 0.5, risk_increment = 0.001)
#' @examples eff.optimal.point <- eff[eff$sharpe==max(eff$sharpe),  ]
mvef_portfolio <- function (R, short = "no", max_allocation = NULL,
                               risk_premium_up = 0.5, risk_increment = 0.005) {

  # return argument should be a m x n matrix with one column per security
  # short argument is whether short-selling is allowed; default is no (short selling prohibited)
  # max_allocation is the maximum % allowed for any one security (reduces concentration)
  # risk_premium_up is the upper limit of the risk premium modeled (see for loop below)
  # risk_increment is the increment (by) value used in the for loop

  covariance <- make.positive.definite(cov(R))
  #print(covariance)
  n <- ncol(covariance)

  # Create initial Amat and bvec assuming only equality constraint (short-selling is allowed, no allocation constraints)
  Amat <- matrix (1, nrow = n)
  bvec <- 1
  meq <- 1

  # Then modify the Amat and bvec if short-selling is prohibited
  if(short == "no") {
    Amat <- cbind(1, diag(n))
    bvec <- c(bvec, rep(0, n))
  }

  # And modify Amat and bvec if a max allocation (concentration) is specified
  if(!is.null(max_allocation)) {
    if(max_allocation > 1 | max_allocation < 0){
      stop("max_allocation must be greater than 0 and less than 1")
    }
    if(max_allocation * n < 1) {
      stop("Need to set max_allocation higher; not enough assets to add to 1")
    }
    Amat <- cbind(Amat, -diag(n))
    bvec <- c(bvec, rep(-max_allocation, n))
  }

  # Calculate the number of loops based on how high to vary the risk premium and by what increment
  loops <- risk_premium_up / risk_increment + 1
  loop <- 1

  # Initialize a matrix to contain allocation and statistics
  # This is not necessary, but speeds up processing and uses less memory
  eff <- matrix(nrow=loops, ncol=n+3)
  # Now I need to give the matrix column names
  colnames(eff) <- c(colnames(R), "Std.Dev", "Exp.Return", "sharpe")

  # Loop through the quadratic program solver
  for (i in seq(from=0, to=risk_premium_up, by=risk_increment))  {
    dvec <- colMeans(R) * i # This moves the solution up along the efficient frontier
    sol <- solve.QP(covariance, dvec=dvec, Amat=Amat, bvec=bvec, meq=meq)
    eff[loop,"Std.Dev"] <- sqrt(sum(sol$solution *colSums((covariance * sol$solution))))
    eff[loop, "Exp.Return"] <- as.numeric(sol$solution %*% colMeans(R))
    eff[loop, "sharpe"] <- eff[loop,"Exp.Return"] / eff[loop,"Std.Dev"]
    eff[loop, 1:n] <- sol$solution
    loop <- loop+1
  }

  return(as.data.frame(eff))
}