# 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)
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:
Downside risk portfolios
First, let’s define the downside risk portfolio (as well as the two benchmarks MVP and GMVP):
library(CVXR)
<- function(mu, Sigma, lambda = 1, ub = Inf) {
design_MVP <- Variable(nrow(Sigma))
w <- Problem(Maximize(t(mu) %*% w - (lambda/2)*quad_form(w, Sigma)),
prob constraints = list(w >= 0, sum(w) == 1, w <= ub))
<- solve(prob)
result <- as.vector(result$getValue(w))
w return(w)
}
<- function(Sigma) design_MVP(mu = rep(0, ncol(Sigma)), Sigma = Sigma)
design_GMVP
<- function(X, alpha = 2, lmd = Inf, tau = c("mu", "zero")) {
design_DRportfolio <- as.matrix(X)
X <- ncol(X)
N
# disaster level
<- match.arg(tau)
tau if (tau == "zero")
<- rep(0, N)
mu else
<- colMeans(X)
mu
# design
<- Variable(N)
w if (lmd == Inf)
<- Problem(Minimize(mean(pos(t(mu) %*% w - X %*% w)^alpha)),
prob constraints = list(w >= 0, sum(w) == 1))
else
<- Problem(Maximize(t(w) %*% mu - lmd * mean(pos(t(mu) %*% w - X %*% w)^alpha)),
prob constraints = list(w >= 0, sum(w) == 1))
if (alpha == 1)
<- solve(prob, solver = "GLPK") #installed_solvers()
result else
<- solve(prob)
result if (!result$status %in% c("optimal", "optimal_inaccurate"))
browser()
return(as.vector(result$getValue(w)))
}
Then, prepare all the portfolio instances for the backtest:
<- function(data, ...) {
EWP <- ncol(data[[1]])
N return(rep(1/N, N))
}
<- function(dataset, ...) {
GMVP <- diff(log(dataset$prices))[-1]
X <- cov(X)
Sigma design_GMVP(Sigma)
}
<- function(dataset, ...) {
MVP <- diff(log(dataset$prices))[-1]
X <- cov(X)
Sigma <- colMeans(X)
mu design_MVP(mu, Sigma, lambda = 100)
}
<- function(dataset, ...) {
DR_alpha1 <- diff(log(dataset$prices))[-1]
X design_DRportfolio(X, alpha = 1, tau = "zero")
}
<- function(dataset, ...) {
DR_alpha2 <- diff(log(dataset$prices))[-1]
X design_DRportfolio(X, alpha = 2, tau = "zero")
}
<- function(dataset, ...) {
DR_alpha2_approx <- diff(log(dataset$prices))[-1]
X <- 0
tau <- pmax(tau - X, 0)
Xpos <- cov(Xpos)
Sigma design_GMVP(Sigma)
}
<- function(dataset, ...) {
DR_alpha3 <- diff(log(dataset$prices))[-1]
X design_DRportfolio(X, alpha = 3, tau = "zero")
}
Single backtest
Portfolio allocation of different downside risk portfolios:
library(pob)
<- SP500_2015to2020$stocks["2019::",
stock_prices c("AAPL", "AMZN", "AMD", "GM", "GOOGL", "MGM", "MSFT", "QCOM", "TSCO", "UPS")]
# backtest
<- portfolioBacktest(list("GMVP" = GMVP,
bt "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")
<- backtestSummary(bt)
bt_summary_median summaryTable(bt_summary_median, type = "kable",
measures = c("Sharpe ratio", "Sortino ratio", "annual return", "annual volatility", "downside deviation", "CVaR", "max drawdown"))
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:
<- backtestChartCumReturn(bt) +
p1 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")
<- backtestChartDrawdown(bt) +
p2 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")
/ p2 + plot_layout(guides = "collect") p1