# 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)
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"))| 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")
Multiple backtests
Backtest performance of different downside risk portfolios (\(N=50\)) over 50 datasets:
library(pob)
# resample data
set.seed(42)
stock_prices_resampled <- financialDataResample(list("prices" = SP500_2015to2020$stocks),
num_datasets = 50, N_sample = 50, T_sample = 252*2)50 datasets resampled (with N = 50 instruments and length T = 504) from the original data between 2015-01-05 and 2020-09-22.# perform multiple backtest on the resampled data
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),
dataset_list = stock_prices_resampled,
lookback = 12*21, optimize_every = 21, rebalance_every = 1,
paral_datasets = 6, show_progress_bar = TRUE)Backtesting 5 portfolios over 50 datasets (periodicity = daily data)... Backtesting function "GMVP " (1/5) Backtesting function "Min. downside risk (alpha = 1)" (2/5) Backtesting function "Min. semivariance" (3/5) Backtesting function "Min. semivariance (approx)" (4/5) Backtesting function "Min. downside risk (alpha = 3)" (5/5)listPortfoliosWithFailures(bt)
bt_summary_median <- backtestSummary(bt)
summaryTable(bt_summary_median, type = "kable", measures = c("Sharpe ratio", "CVaR", "max drawdown", "cpu time"))| Portfolio | Sharpe ratio | max drawdown | cpu time |
|---|---|---|---|
| GMVP | 1.38 | 9% | 0.17 |
| Min. downside risk (alpha = 1) | 1.45 | 9% | 0.19 |
| Min. semivariance | 1.43 | 9% | 0.16 |
| Min. semivariance (approx) | 1.48 | 9% | 0.18 |
| Min. downside risk (alpha = 3) | 1.43 | 9% | 0.27 |
p1 <- backtestBoxPlot(bt, "Sharpe ratio") + coord_flip(ylim = c(0, 2.5)) +
scale_x_discrete(labels = c("GMVP", TeX("Min. downside risk ($\\alpha = 1$)"), "Min. semivariance",
"Min. semivariance (approx)", TeX("Min. downside risk ($\\alpha$ = 3)")),
limits = rev(names(bt)))
p2 <- backtestBoxPlot(bt, "max drawdown") + coord_flip(ylim = c(0, 0.2)) +
scale_x_discrete(labels = c("GMVP", TeX("Min. downside risk ($\\alpha = 1$)"), "Min. semivariance",
"Min. semivariance (approx)", TeX("Min. downside risk ($\\alpha$ = 3)")),
limits = rev(names(bt)))
p1 / p2
Tail portfolios
First, let’s define the worst-case portfolio, the CVaR portfolio, and the EVaR portfolio:
library(CVXR)
library(nloptr)
library(alabama)
portolioWorstCase <- function(X, lmd = 5) {
T <- nrow(X)
N <- ncol(X)
X <- as.matrix(X)
mu <- colMeans(X)
# design (https://cvxr.rbind.io/cvxr_functions/)
w <- Variable(N)
prob <- Problem(Maximize(t(w) %*% mu - lmd * max_entries(- X %*% w)),
constraints = list(w >= 0, sum(w) == 1))
result <- solve(prob, solver = "GLPK") #installed_solvers()
return(as.vector(result$getValue(w)))
}
portolioCVaR <- function(X, lmd = 5, alpha = 0.95) {
T <- nrow(X)
N <- ncol(X)
X <- as.matrix(X)
mu <- colMeans(X)
w <- Variable(N)
tau <- Variable(1)
u <- Variable(T)
prob <- Problem(Maximize( t(w) %*% mu - lmd*(tau + mean(u)/(1-alpha)) ),
constraints = list(u >= 0, u >= -X %*% w - tau,
w >= 0, sum(w) == 1))
tryCatch(result <- solve(prob, solver = "GLPK"), #installed_solvers()
error = function(e) geterrmessage())
return(as.vector(result$getValue(w)))
}
#w <- CVaR_alpha95(stock_prices_resampled$`dataset 1`)
portolioEVaR_CVXR <- function(X, lmd = 1000, alpha = 0.95) {
T <- nrow(X)
N <- ncol(X)
X <- as.matrix(X)
mu <- colMeans(X)
# CVXR
w <- Variable(N)
s <- Variable(1)
t <- Variable(1)
u <- Variable(T)
prob <- Problem(Maximize( t(w) %*% mu - lmd*( s - t*log((1-alpha)*T) ) ),
constraints = list(CVXR:::ExpCone(- X %*% w - s, t*rep(1,T), u),
t >= sum(u),
w >= 0, sum(w) == 1))
result <- solve(prob, num_iter = 200, verbose = FALSE)
return(as.vector(result$getValue(w)))
}
# https://docs.mosek.com/modeling-cookbook/expo.html
portolioEVaR_nloptr <- function(X, lmd = Inf, alpha = 0.95) {
T <- nrow(X)
N <- ncol(X)
X <- as.matrix(X)
mu <- colMeans(X)
#
# via general solver nloptr
#
w0 <- rep(1/N, N)
t0 <- 1
fn_min <- function(x) {
w <- x[1:N]
t <- x[N+1]
-( t(w) %*% mu - lmd*t*log(mean(exp(- X %*% (w/t)))/(1-alpha)) )
}
h_eq <- function(x) {
w <- x[1:N]
t <- x[N+1]
sum(w) - 1
}
h_eq_jac <- function(x) {
w <- x[1:N]
t <- x[N+1]
rbind(c(rep(1, N), 0))
}
res <- nloptr::slsqp(x0 = c(w0, t0),
fn = fn_min, # gr =
lower = rep(0, N + 1),
heq = h_eq, heqjac = h_eq_jac,
control = list(xtol_rel = 1e-6)) # check_derivatives = TRUE
w_nloptr <- res$par[1:N]
t_nloptr <- res$par[N+1]
return(w_nloptr)
}Then, prepare all the portfolio instances for the backtest:
CVaR_alpha90 <- function(dataset, ...) {
X <- diff(log(dataset$prices))[-1]
portolioCVaR(X, lmd = 10000, alpha = 0.90)
}
CVaR_alpha95 <- function(dataset, ...) {
X <- diff(log(dataset$prices))[-1]
portolioCVaR(X, lmd = 10000, alpha = 0.95)
}
CVaR_alpha99 <- function(dataset, ...) {
X <- diff(log(dataset$prices))[-1]
portolioCVaR(X, lmd = 10000, alpha = 0.99)
}
EVaR_alpha90 <- function(dataset, ...) {
X <- diff(log(dataset$prices))[-1]
portolioEVaR_nloptr(X, lmd = 10000, alpha = 0.90)
}
EVaR_alpha95 <- function(dataset, ...) {
X <- diff(log(dataset$prices))[-1]
portolioEVaR_nloptr(X, lmd = 10000, alpha = 0.95)
}
EVaR_alpha99 <- function(dataset, ...) {
X <- diff(log(dataset$prices))[-1]
portolioEVaR_nloptr(X, lmd = 10000, alpha = 0.99)
}
WorstCase <- function(dataset, ...) {
X <- diff(log(dataset$prices))[-1]
portolioWorstCase(X, lmd = 10000)
}Single backtest
Portfolio allocation of different tail 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. CVaR 90%" = CVaR_alpha90,
"Min. EVaR 90%" = EVaR_alpha90,
"Min. Worst-Case" = WorstCase),
list(list("prices" = stock_prices)),
lookback = 12*21, optimize_every = 21, rebalance_every = 1)Backtesting 4 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. CVaR 90%" = as.numeric(bt$`Min. CVaR 90%`$data1$w_optimized[1, ]),
"Min. EVaR 90%" = as.numeric(bt$`Min. EVaR 90%`$data1$w_optimized[1, ]),
"Min. Worst-Case" = as.numeric(bt$`Min. Worst-Case`$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"))| Portfolio | Sharpe ratio | Sortino ratio | annual return | annual volatility | downside deviation | max drawdown |
|---|---|---|---|---|---|---|
| GMVP | 1.70 | 2.44 | 61% | 36% | 0.25 | 27% |
| Min. CVaR 90% | 1.59 | 2.28 | 59% | 37% | 0.26 | 28% |
| Min. EVaR 90% | 1.57 | 2.27 | 59% | 38% | 0.26 | 28% |
| Min. Worst-Case | 1.24 | 1.79 | 48% | 38% | 0.27 | 33% |
Backtest performance of different tail 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")
Multiple backtests
Backtest performance of CVaR and EVaR portfolios (\(N=10\)) over 50 datasets:
library(pob)
# resample data
set.seed(42)
stock_prices_resampled <- financialDataResample(list("prices" = SP500_2015to2020$stocks),
num_datasets = 50, N_sample = 10, T_sample = 252*2)50 datasets resampled (with N = 10 instruments and length T = 504) from the original data between 2015-01-05 and 2020-09-22.# perform multiple backtest on the resampled data
bt <- portfolioBacktest(list("GMVP" = GMVP,
"Min. CVaR 90%" = CVaR_alpha90,
"Min. EVaR 90%" = EVaR_alpha90,
"Min. CVaR 95%" = CVaR_alpha95,
"Min. EVaR 95%" = EVaR_alpha95,
"Min. CVaR 99%" = CVaR_alpha99,
"Min. EVaR 99%" = EVaR_alpha99,
"Min. Worst-Case" = WorstCase),
dataset_list = stock_prices_resampled,
lookback = 12*21, optimize_every = 21, rebalance_every = 1,
paral_datasets = 6, show_progress_bar = TRUE)Backtesting 8 portfolios over 50 datasets (periodicity = daily data)... Backtesting function "GMVP " (1/8) Backtesting function "Min. CVaR 90% " (2/8) Backtesting function "Min. EVaR 90% " (3/8) Backtesting function "Min. CVaR 95% " (4/8) Backtesting function "Min. EVaR 95% " (5/8) Backtesting function "Min. CVaR 99% " (6/8) Backtesting function "Min. EVaR 99% " (7/8) Backtesting function "Min. Worst-Case" (8/8)listPortfoliosWithFailures(bt)
bt_summary_median <- backtestSummary(bt)
summaryTable(bt_summary_median, type = "kable", measures = c("Sharpe ratio", "CVaR", "max drawdown", "cpu time"))| Portfolio | Sharpe ratio | max drawdown | cpu time |
|---|---|---|---|
| GMVP | 0.99 | 12% | 0.14 |
| Min. CVaR 90% | 0.92 | 11% | 0.17 |
| Min. EVaR 90% | 1.00 | 13% | 0.03 |
| Min. CVaR 95% | 1.02 | 11% | 0.17 |
| Min. EVaR 95% | 1.03 | 13% | 0.03 |
| Min. CVaR 99% | 0.95 | 12% | 0.17 |
| Min. EVaR 99% | 0.91 | 13% | 0.35 |
| Min. Worst-Case | 1.01 | 12% | 0.13 |
p1 <- backtestBoxPlot(bt, "Sharpe ratio") + coord_flip(ylim = c(-0.5, 2.5))
p2 <- backtestBoxPlot(bt, "max drawdown") + coord_flip(ylim = c(0, 0.3))
p1 / p2
Drawdown portfolios
First, let’s define the max-drawdown portfolio, ave-drawdown portfolio, and CVaR-drawdown portfolio:
library(CVXR)
portfolioMaxDD <- function(X, lmd = 5) {
T <- nrow(X)
N <- ncol(X)
X <- as.matrix(X)
X_cum <- apply(X, MARGIN = 2, FUN = cumsum)
mu <- colMeans(X)
# variables
w <- Variable(N)
s <- Variable(1)
u <- Variable(T)
# problem
prob <- Problem(Maximize(t(w) %*% mu - lmd*s),
constraints = list(w >= 0, sum(w) == 1,
u <= X_cum %*% w + s,
u >= X_cum %*% w,
u[-1] >= u[-T]))
result <- solve(prob, solver = "GLPK") #installed_solvers()
return(as.vector(result$getValue(w)))
}
portfolioAveDD <- function(X, lmd = 5) {
T <- nrow(X)
N <- ncol(X)
X <- as.matrix(X)
X_cum <- apply(X, MARGIN = 2, FUN = cumsum)
mu <- colMeans(X)
# variables
w <- Variable(N)
s <- Variable(1)
u <- Variable(T)
# problem
prob <- Problem(Maximize(t(w) %*% mu- lmd*s),
constraints = list(w >= 0, sum(w) == 1,
mean(u) <= mean(X_cum %*% w) + s,
u >= X_cum %*% w,
u[-1] >= u[-T]))
result <- solve(prob, solver = "GLPK") #installed_solvers()
return(as.vector(result$getValue(w)))
}
#w <- portfolioAveDD(X = diff(log(stock_prices_resampled$`dataset 1`$prices))[-1])
portfolioCVaRDD <- function(X, lmd = 5, alpha = 0.95) {
T <- nrow(X)
N <- ncol(X)
X <- as.matrix(X)
X_cum <- apply(X, MARGIN = 2, FUN = cumsum)
mu <- colMeans(X)
# variables
w <- Variable(N)
tau <- Variable(1)
s <- Variable(1)
z <- Variable(T)
u <- Variable(T)
# problem
prob <- Problem(Maximize(t(w) %*% mu - lmd*s),
constraints = list(w >= 0, sum(w) == 1,
s >= tau + mean(z)/(1-alpha),
z >= 0, z >= u - X_cum %*% w - tau,
u >= X_cum %*% w,
u[-1] >= u[-T]))
result <- solve(prob, solver = "GLPK") #installed_solvers()
return(as.vector(result$getValue(w)))
}Then, prepare all the portfolio instances for the backtest:
MaxDD <- function(dataset, ...) {
X <- diff(log(dataset$prices))[-1]
portfolioMaxDD(X, lmd = 1000)
}
AveDD <- function(dataset, ...) {
X <- diff(log(dataset$prices))[-1]
portfolioAveDD(X, lmd = 1000)
}
CVaRDD_alpha90 <- function(dataset, ...) {
X <- diff(log(dataset$prices))[-1]
portfolioCVaRDD(X, lmd = 1000, alpha = 0.90)
}
CVaRDD_alpha95 <- function(dataset, ...) {
X <- diff(log(dataset$prices))[-1]
portfolioCVaRDD(X, lmd = 1000, alpha = 0.95)
}
CVaRDD_alpha99 <- function(dataset, ...) {
X <- diff(log(dataset$prices))[-1]
portfolioCVaRDD(X, lmd = 1000, alpha = 0.99)
}Single backtest
Portfolio allocation of different drawdown 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. Max-DD" = MaxDD,
"Min. Ave-DD" = AveDD,
"Min. CVaR-DD 90%" = CVaRDD_alpha90),
list(list("prices" = stock_prices)),
lookback = 12*21, optimize_every = 21, rebalance_every = 1)Backtesting 4 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. Max-DD" = as.numeric(bt$`Min. Max-DD`$data1$w_optimized[1, ]),
"Min. Ave-DD" = as.numeric(bt$`Min. Ave-DD`$data1$w_optimized[1, ]),
"Min. CVaR-DD 90%" = as.numeric(bt$`Min. CVaR-DD 90%`$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"))| Portfolio | Sharpe ratio | Sortino ratio | annual return | annual volatility | downside deviation | max drawdown |
|---|---|---|---|---|---|---|
| GMVP | 1.70 | 2.44 | 61% | 36% | 0.25 | 27% |
| Min. Max-DD | 1.81 | 2.55 | 73% | 41% | 0.29 | 32% |
| Min. Ave-DD | 1.61 | 2.37 | 72% | 45% | 0.31 | 27% |
| Min. CVaR-DD 90% | 1.80 | 2.65 | 82% | 45% | 0.31 | 29% |
Backtest performance of different tail 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")
Multiple backtests
Backtest performance of drawdown portfolios (\(N=10\)) over 50 datasets:
library(pob)
# resample data
set.seed(42)
stock_prices_resampled <- financialDataResample(list("prices" = SP500_2015to2020$stocks),
num_datasets = 50, N_sample = 10, T_sample = 252*2)50 datasets resampled (with N = 10 instruments and length T = 504) from the original data between 2015-01-05 and 2020-09-22.# perform multiple backtest on the resampled data
bt <- portfolioBacktest(list("GMVP" = GMVP,
"Min. Max-DD" = MaxDD,
"Min. Ave-DD" = AveDD,
"Min. CVaR-DD 90%" = CVaRDD_alpha90,
"Min. CVaR-DD 95%" = CVaRDD_alpha95,
"Min. CVaR-DD 99%" = CVaRDD_alpha99),
dataset_list = stock_prices_resampled,
lookback = 12*21, optimize_every = 21, rebalance_every = 1,
paral_datasets = 6, show_progress_bar = TRUE)Backtesting 6 portfolios over 50 datasets (periodicity = daily data)... Backtesting function "GMVP " (1/6) Backtesting function "Min. Max-DD " (2/6) Backtesting function "Min. Ave-DD " (3/6) Backtesting function "Min. CVaR-DD 90%" (4/6) Backtesting function "Min. CVaR-DD 95%" (5/6) Backtesting function "Min. CVaR-DD 99%" (6/6)listPortfoliosWithFailures(bt)
bt_summary_median <- backtestSummary(bt)
summaryTable(bt_summary_median, type = "kable", measures = c("Sharpe ratio", "CVaR", "max drawdown", "cpu time"))| Portfolio | Sharpe ratio | max drawdown | cpu time |
|---|---|---|---|
| GMVP | 0.99 | 12% | 0.14 |
| Min. Max-DD | 0.96 | 13% | 0.17 |
| Min. Ave-DD | 0.98 | 12% | 0.19 |
| Min. CVaR-DD 90% | 1.00 | 12% | 0.26 |
| Min. CVaR-DD 95% | 0.88 | 12% | 0.26 |
| Min. CVaR-DD 99% | 1.01 | 12% | 0.26 |
p1 <- backtestBoxPlot(bt, "Sharpe ratio") + coord_flip(ylim = c(-0.5, 2.5))
p2 <- backtestBoxPlot(bt, "max drawdown") + coord_flip(ylim = c(0, 0.3))
p1 / p2