Portfolio Optimization
Chapter 10: Portfolios with Alternative Risk Measures

R code

R code examples for Chapter 10 of the book:

Daniel P. Palomar (2024). Portfolio Optimization: Theory and Application. Cambridge University Press.

Loading packages

The following packages are used in the examples:

# basic finance
library(xts)                    # to manipulate time series of stock data
library(PerformanceAnalytics)   # to compute performance measures
library(portfolioBacktest)      # to conduct backtests
library(pob)                    # book package with financial data

# plotting
library(ggplot2)                # for nice plots
library(reshape2)               # to reshape data
library(patchwork)              # for combining plots
library(latex2exp)              # for latex symbols with TeX()

# optimization
library(CVXR)
library(nloptr)
library(alabama)

Downside risk portfolios

First, let’s define the downside risk portfolio (as well as the two benchmarks MVP and GMVP):

library(CVXR)

design_MVP <- function(mu, Sigma, lambda = 1, ub = Inf) {
  w <- Variable(nrow(Sigma))
  prob <- Problem(Maximize(t(mu) %*% w - (lambda/2)*quad_form(w, Sigma)),
                  constraints = list(w >= 0, sum(w) == 1, w <= ub))
  result <- solve(prob)
  w <- as.vector(result$getValue(w))
  return(w)
}

design_GMVP <- function(Sigma) design_MVP(mu = rep(0, ncol(Sigma)), Sigma = Sigma)

design_DRportfolio <- function(X, alpha = 2, lmd = Inf, tau = c("mu", "zero")) {
  X <- as.matrix(X)
  N <- ncol(X)
  
  # disaster level
  tau <- match.arg(tau)
  if (tau == "zero")
    mu <- rep(0, N)
  else
    mu <- colMeans(X)
  
  # design
  w <- Variable(N)
  if (lmd == Inf)
    prob <- Problem(Minimize(mean(pos(t(mu) %*% w - X %*% w)^alpha)),
                    constraints = list(w >= 0, sum(w) == 1))
  else
    prob <- Problem(Maximize(t(w) %*% mu - lmd * mean(pos(t(mu) %*% w - X %*% w)^alpha)),
                    constraints = list(w >= 0, sum(w) == 1))
  
  if (alpha == 1)
    result <- solve(prob, solver = "GLPK")  #installed_solvers()
  else
    result <- solve(prob)
  if (!result$status %in% c("optimal", "optimal_inaccurate"))
    browser()
  return(as.vector(result$getValue(w)))
}

Then, prepare all the portfolio instances for the backtest:

EWP <- function(data, ...) {
  N <- ncol(data[[1]])
  return(rep(1/N, N))
}

GMVP <- function(dataset, ...) {
  X <- diff(log(dataset$prices))[-1]
  Sigma <- cov(X)
  design_GMVP(Sigma)
}

MVP <- function(dataset, ...) {
  X <- diff(log(dataset$prices))[-1]
  Sigma <- cov(X)
  mu <- colMeans(X)
  design_MVP(mu, Sigma, lambda = 100)
}

DR_alpha1 <- function(dataset, ...) {
  X <- diff(log(dataset$prices))[-1]
  design_DRportfolio(X, alpha = 1, tau = "zero")
}

DR_alpha2 <- function(dataset, ...) {
  X <- diff(log(dataset$prices))[-1]
  design_DRportfolio(X, alpha = 2, tau = "zero")
}

DR_alpha2_approx <- function(dataset, ...) {
  X <- diff(log(dataset$prices))[-1]
  tau <- 0
  Xpos <- pmax(tau - X, 0)
  Sigma <- cov(Xpos)
  design_GMVP(Sigma)
}

DR_alpha3 <- function(dataset, ...) {
  X <- diff(log(dataset$prices))[-1]
  design_DRportfolio(X, alpha = 3, tau = "zero")
}

Single backtest

Portfolio allocation of different downside risk portfolios:

library(pob)
stock_prices <- SP500_2015to2020$stocks["2019::", 
                                        c("AAPL", "AMZN", "AMD", "GM", "GOOGL", "MGM", "MSFT", "QCOM", "TSCO", "UPS")]

# backtest
bt <- portfolioBacktest(list("GMVP"                            = GMVP,
                             "Min. downside risk (alpha = 1)"  = DR_alpha1,
                             "Min. semivariance"               = DR_alpha2,
                             "Min. semivariance (approx)"      = DR_alpha2_approx,
                             "Min. downside risk (alpha = 3)"  = DR_alpha3),
                        list(list("prices" = stock_prices)),
                        lookback = 12*21, optimize_every = 21, rebalance_every = 1)

Backtesting 5 portfolios over 1 datasets (periodicity = daily data)...

listPortfoliosWithFailures(bt)

data.frame(
  "stocks" = names(stock_prices),
  "GMVP"   = as.numeric(bt$`GMVP`$data1$w_optimized[1, ]),
  "Min. downside risk (alpha = 1)" = as.numeric(bt$`Min. downside risk (alpha = 1)`$data1$w_optimized[1, ]),
  "Min. semivariance"              = as.numeric(bt$`Min. semivariance`$data1$w_optimized[1, ]),
  "Min. semivariance (approx)"     = as.numeric(bt$`Min. semivariance (approx)`$data1$w_optimized[1, ]),
  "Min. downside risk (alpha = 3)" = as.numeric(bt$`Min. downside risk (alpha = 3)`$data1$w_optimized[1, ]),
  check.names = FALSE) |> 
  melt(id.vars = "stocks") |>
  ggplot(aes(x = stocks, y = value, fill = variable)) +
  geom_bar(stat = "identity", position = "dodge", color = "black", width = 0.8) +
  labs(fill = "portfolios") +
  ylab("weight") +
  ggtitle("Portfolio weights")

bt_summary_median <- backtestSummary(bt)
summaryTable(bt_summary_median, type = "kable",
             measures = c("Sharpe ratio", "Sortino ratio", "annual return", "annual volatility", "downside deviation", "CVaR", "max drawdown"))

Performance table

Portfolio	Sharpe ratio	Sortino ratio	annual return	annual volatility	downside deviation	max drawdown
GMVP	1.70	2.44	61%	36%	0.25	27%
Min. downside risk (alpha = 1)	1.73	2.51	66%	38%	0.26	26%
Min. semivariance	1.78	2.58	67%	38%	0.26	27%
Min. semivariance (approx)	1.75	2.51	64%	37%	0.25	27%
Min. downside risk (alpha = 3)	1.78	2.60	67%	37%	0.26	27%

Backtest performance of different downside risk portfolios:

p1 <- backtestChartCumReturn(bt) + 
  scale_x_date(date_breaks = "6 months", date_labels = "%b %Y", date_minor_breaks = "1 week") +
  theme(legend.title = element_text()) + labs(color = "portfolios", linetype = "portfolios") +
  ggtitle("Cumulative return")

p2 <- backtestChartDrawdown(bt) +
  scale_x_date(date_breaks = "6 months", date_labels = "%b %Y", date_minor_breaks = "1 week") +
  theme(legend.title = element_text()) + labs(color = "portfolios", linetype = "portfolios") +
  ggtitle("Drawdown")

p1 / p2 + plot_layout(guides = "collect")