# 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
# install with: devtools::install_github("dppalomar/pob")
# plotting
library(ggplot2) # for nice plots
library(reshape2) # to reshape data
# optimization
library(CVXR)
Portfolio Optimization
Chapter 8: Portfolio Backtesting
R code
R code examples for Chapter 8 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:
Market data and portfolios
For illustrative purposes, we simply choose a few stocks from the S&P 500 index during 2015-2020.
data(SP500_2015to2020)
<- SP500_2015to2020$stocks["2018::", c("AAPL", "AMZN", "AMD", "GM", "GOOGL", "MGM", "MSFT", "QCOM", "TSCO", "UPS")]
stock_prices
head(stock_prices)
AAPL AMZN AMD GM GOOGL MGM MSFT QCOM TSCO
2018-01-02 41.514 1189.01 10.98 38.0722 1073.21 32.1285 82.5993 59.2277 72.8300
2018-01-03 41.506 1204.20 11.55 39.0012 1091.52 31.9559 82.9837 59.8999 73.3785
2018-01-04 41.699 1209.59 12.12 40.2035 1095.76 32.2723 83.7141 59.9817 74.6969
2018-01-05 42.174 1229.14 11.88 40.0851 1110.29 32.4928 84.7520 60.3814 76.4484
2018-01-08 42.017 1246.87 12.28 40.2764 1114.21 31.7354 84.8385 60.1997 76.2655
2018-01-09 42.012 1252.70 11.82 40.1216 1112.79 32.2435 84.7808 59.2913 76.4965
UPS
2018-01-02 112.662
2018-01-03 115.158
2018-01-04 115.906
2018-01-05 116.261
2018-01-08 117.673
2018-01-09 117.618
tail(stock_prices)
AAPL AMZN AMD GM GOOGL MGM MSFT QCOM TSCO
2020-09-15 115.54 3156.13 78.93 31.58 1535.12 23.74 208.78 116.58 140.880
2020-09-16 112.13 3078.10 76.66 31.79 1512.09 23.01 205.05 114.56 138.250
2020-09-17 110.34 3008.73 76.55 31.92 1487.04 22.52 202.91 114.88 138.150
2020-09-18 106.84 2954.91 74.93 31.50 1451.09 22.02 200.39 110.69 138.110
2020-09-21 110.08 2960.47 77.94 30.00 1430.14 21.09 202.54 111.92 137.555
2020-09-22 111.81 3128.99 77.70 29.44 1459.82 21.62 207.42 113.82 141.610
UPS
2020-09-15 161.53
2020-09-16 159.87
2020-09-17 159.75
2020-09-18 159.66
2020-09-21 161.06
2020-09-22 161.89
log(stock_prices) |>
fortify(melt = TRUE) |>
ggplot(aes(x = Index, y = Value, color = Series)) +
geom_line(linewidth = 1) +
scale_x_date(date_breaks = "6 months", date_labels = "%b %Y", date_minor_breaks = "1 week") +
labs(title = "Log-prices", x = NULL, y = NULL, color = "stocks")
Also for illustrative purposes, we choose the following three simple portfolios:
- \(1/N\) portfolio: \[ \w = \frac{1}{N}\bm{1}; \]
- Global minimum variance portfolio (GMVP): \[ \begin{array}{ll} \underset{\w}{\textm{minimize}} & \w^\T\bSigma\w\\ \textm{subject to} & \bm{1}^\T\w=1, \quad \w\ge\bm{0}; \textm{ and } \end{array} \]
- Inverse volatility portfolio (IVP): \[ \w = \frac{\bm{\sigma}^{-1}}{\bm{1}^\T\bm{\sigma}^{-1}}. \]
<- function(dataset, ...) {
one_over_N <- ncol(dataset$prices)
N return(rep(1/N, N))
}
<- function(Sigma) {
design_GMVP <- Variable(nrow(Sigma))
w <- Problem(Minimize(quad_form(w, Sigma)),
prob constraints = list(w >= 0, sum(w) == 1))
<- solve(prob)
result <- as.vector(result$getValue(w))
w return(w)
}
<- function(dataset, ...) {
GMVP <- ncol(dataset$prices)
N <- diff(log(dataset$prices))[-1]
X <- cov(X)
Sigma <- design_GMVP(Sigma)
w return(w)
}
<- function(sigma) {
design_IVP <- 1/sigma
w <- w/sum(w)
w return(w)
}
<- function(dataset, ...) {
IVP <- ncol(dataset$prices)
N <- diff(log(dataset$prices))[-1]
X <- apply(X, 2, sd, na.rm = TRUE)
sigma <- design_IVP(sigma)
w return(w)
}
Vanilla backtesting
Vanilla backtesting refers to simply dividing the available data intro training data (for the portfolio design) and test data (for the portfolio assessment).
Daily rebalancing ignoring transaction costs
If we assume a daily rebalancing (with daily data) and ignore transaction costs, then the backtest is very simple to perform simply by multiplying the matrix of assets’ linear returns by the portfolio vector.
# compute linear and log-returns
<- stock_prices/lag(stock_prices) - 1
X_lin <- diff(log(stock_prices))
X_log
# split data into training and test data
<- ncol(stock_prices)
N <- nrow(stock_prices)
T <- round(0.50*T)
T_trn <- X_lin[1:T_trn, ]
X_lin_trn <- X_lin[-c(1:T_trn), ]
X_lin_tst <- X_log[1:T_trn, ]
X_log_trn <- X_log[-c(1:T_trn), ]
X_log_tst
# estimate mu and Sigma with training data (removing first row of NAs)
<- colMeans(X_log_trn[-1, ])
mu <- cov(X_log_trn[-1, ])
Sigma
# design portfolios
<- rep(1/N, N)
w_one_over_N <- design_GMVP(Sigma)
w_GMVP <- design_IVP(sqrt(diag(Sigma)))
w_IVP
# backtest portfolios with test data (assuming daily rebalancing and no transaction cost)
<- xts(X_lin_tst %*% w_one_over_N, index(X_lin_tst))
ret_one_over_N <- xts(X_lin_tst %*% w_GMVP, index(X_lin_tst))
ret_GMVP <- xts(X_lin_tst %*% w_IVP, index(X_lin_tst))
ret_IVP
# compute cumulative returns or wealth or NAV
<- cumprod(1 + ret_one_over_N)
wealth_one_over_N <- cumprod(1 + ret_GMVP)
wealth_GMVP <- cumprod(1 + ret_IVP)
wealth_IVP
# plot
cbind("1/N" = wealth_one_over_N,
"GMVP" = wealth_GMVP,
"IVP" = wealth_IVP,
check.names = FALSE) |>
fortify(melt = TRUE) |>
ggplot(aes(x = Index, y = Value, color = Series)) +
geom_line(linewidth = 1) +
scale_x_date(date_breaks = "2 months", date_labels = "%b %Y", date_minor_breaks = "1 week") +
labs(title = "Cumulative returns", x = NULL, y = NULL, color = "Portfolios")
We can now conveniently reproduce the same backtest using the package portfolioBacktest
:
# perform backtest
<- portfolioBacktest(portfolio_funs = list("1/N" = one_over_N,
bt "GMVP" = GMVP,
"IVP" = IVP),
dataset_list = list("dataset1" = list("prices" = stock_prices)), price_name = "prices",
lookback = T_trn, optimize_every = 10000, rebalance_every = 1)
Backtesting 3 portfolios over 1 datasets (periodicity = daily data)...
# sanity check
all(
all.equal(ret_one_over_N, bt$`1/N`$dataset1$return, check.attributes = FALSE),
all.equal(ret_GMVP, bt$`GMVP`$dataset1$return, check.attributes = FALSE),
all.equal(ret_IVP, bt$`IVP`$dataset1$return, check.attributes = FALSE)
)
[1] TRUE
# plot
backtestChartCumReturn(bt) +
scale_x_date(date_breaks = "2 months", date_labels = "%b %Y", date_minor_breaks = "1 week") +
ggtitle("Cumulative returns")
Realistic rebalancing including transaction costs
We can now easily include transaction costs (say, of 60 bps) in the backtest and even reducing the rebalancing period to every week or 5 days (instead of daily) using the package portfolioBacktest
:
# perform backtest
<- portfolioBacktest(portfolio_funs = list("1/N" = one_over_N,
bt "GMVP" = GMVP,
"IVP" = IVP),
dataset_list = list("dataset1" = list("prices" = stock_prices)), price_name = "prices",
lookback = T_trn, optimize_every = 10000, rebalance_every = 5,
cost = list(buy = 60e-4, sell = 60e-4))
Backtesting 3 portfolios over 1 datasets (periodicity = daily data)...
# plot
backtestChartCumReturn(bt) +
scale_x_date(date_breaks = "2 months", date_labels = "%b %Y", date_minor_breaks = "1 week") +
ggtitle("Cumulative returns")
Walk-forward backtesting
Now, rather than keeping the portfolio fixed during all the test data, we can perform a walk-forward backtest by reoptimizing the portfolio every, say, 1 month or 20 days, on a rolling-window basis.
# perform backtest
<- portfolioBacktest(portfolio_funs = list("1/N" = one_over_N,
bt "GMVP" = GMVP,
"IVP" = IVP),
dataset_list = list("dataset1" = list("prices" = stock_prices)), price_name = "prices",
lookback = T_trn, optimize_every = 20, rebalance_every = 5,
cost = list(buy = 60e-4, sell = 60e-4))
Backtesting 3 portfolios over 1 datasets (periodicity = daily data)...
# plot
backtestChartCumReturn(bt) +
scale_x_date(date_breaks = "2 months", date_labels = "%b %Y", date_minor_breaks = "1 week") +
ggtitle("Cumulative returns")
Since the portfolios are changing over time, we can plot the evolution of the portfolios over time:
$`1/N`$dataset1$w_bop |>
btfortify(melt = TRUE) |>
ggplot(aes(x = Index, y = Value, fill = Series)) +
geom_bar(stat = "identity", width = 4.0) +
scale_x_date(date_breaks = "2 months", date_labels = "%b %Y", date_minor_breaks = "1 week") +
labs(title = "Weight allocation over time for portfolio 1/N", x = NULL, y = "weight", color = "stocks")
$`GMVP`$dataset1$w_bop |>
btfortify(melt = TRUE) |>
ggplot(aes(x = Index, y = Value, fill = Series)) +
geom_bar(stat = "identity", width = 4.0) +
scale_x_date(date_breaks = "2 months", date_labels = "%b %Y", date_minor_breaks = "1 week") +
labs(title = "Weight allocation over time for portfolio GMVP", x = NULL, y = "weight", color = "stocks")
$`IVP`$dataset1$w_bop |>
btfortify(melt = TRUE) |>
ggplot(aes(x = Index, y = Value, fill = Series)) +
geom_bar(stat = "identity", width = 4.0) +
scale_x_date(date_breaks = "2 months", date_labels = "%b %Y", date_minor_breaks = "1 week") +
labs(title = "Weight allocation over time for portfolio IVP", x = NULL, y = "weight", color = "stocks")
Multiple randomized backtesting
Finally, rather than running a single backtest, we can introduce some randomness in the data and perform, say, 200 randomized backtests (Palomar, 2024, Chapter 8). Again, this can be conveniently done with the package portfolioBacktest
.
First, we resample 200 times the original data of \(N=10\) stocks over 2017-2020. Each time we select randomly \(N=8\) stocks and a random period of two years.
data(SP500_2015to2020)
<- SP500_2015to2020$stocks["2017::", c("AAPL", "AMZN", "AMD", "GM", "GOOGL", "MGM", "MSFT", "QCOM", "TSCO", "UPS")]
stock_prices
# resample data
<- financialDataResample(list("prices" = stock_prices),
stock_prices_resampled num_datasets = 200, N_sample = 8, T_sample = 252*2)
200 datasets resampled (with N = 8 instruments and length T = 504) from the original data between 2017-01-03 and 2020-09-22.
Then, we perform the backtest (this will take some time):
# perform multiple backtest on the resampled data
<- portfolioBacktest(portfolio_funs = list("1/N" = one_over_N,
bt "GMVP" = GMVP,
"IVP" = IVP),
dataset_list = stock_prices_resampled,
lookback = 252, optimize_every = 20, rebalance_every = 5,
paral_datasets = 6,
cost = list(buy = 60e-4, sell = 60e-4))
Backtesting 3 portfolios over 200 datasets (periodicity = daily data)...
Now we can show the results in a table form:
<- backtestSummary(bt)
summary_bt summaryTable(summary_bt, type = "DT", order_col = "Sharpe ratio", order_dir = "desc",
measures = c("annual return", "annual volatility", "max drawdown",
"Sharpe ratio", "Sortino ratio", "Sterling ratio",
"VaR (0.95)", "CVaR (0.95)"))
And we can also show the results in the form of barplots or boxplots:
summaryBarPlot(summary_bt, measures = c("max drawdown", "annual volatility"))
backtestBoxPlot(bt, "Sharpe ratio")
backtestBoxPlot(bt, "max drawdown")