# basic finance
library(xts) # to manipulate time series of stock data
library(pob) # book package with financial data
# plotting
library(ggplot2) # for nice plots
library(reshape2) # to reshape data
library(dplyr) # for data frame manipulation (e.g., mutate)
library(patchwork) # for combining plots
library(scales) # for axes control
# optimization
library(alabama)
library(nloptr)
library(quadprog)
library(riskParityPortfolio) # for risk parity portfolios
library(microbenchmark) # for cpu computation
Portfolio Optimization
Chapter 11: Risk Parity Portfolios
R code
R code examples for Chapter 11 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:
From dollar to risk diversification
Portfolio allocation and risk allocation for the \(1/N\) portfolio and risk parity portfolio:
library(pob)
library(riskParityPortfolio)
<- SP500_2015to2020$stocks["2020::2020-09", c("AAPL", "NFLX", "TSCO", "MGM", "MSFT", "FB", "AMZN", "GOOGL")]
stock_prices <- nrow(stock_prices)
T <- round(0.70*T)
T_trn <- diff(log(stock_prices[1:T_trn, ]))[-1]
X <- cov(X)
Sigma <- ncol(X)
N
# portfolios
<- rep(1/N, N)
w_EWP <- riskParityPortfolio(Sigma)$w
w_RPP
# barplots
<- data.frame(
df_w "stocks" = names(stock_prices),
"1/N" = w_EWP,
"RPP" = w_RPP,
check.names = FALSE)
# Using package riskParityPortfolio:
# barplotPortfolioRisk(as.matrix(df_w[-1]), Sigma)
# We define our own barplot function for completeness:
<- function(df_w, Sigma) {
barplot_w_and_RCC $stocks <- factor(df_w$stocks, levels = unique(df_w$stocks))
df_w
# get relative risk contribution
<- df_w
df_rrc -1] <- lapply(as.list(df_w[-1]), function(w) {
df_rrc[<- as.vector(w * (Sigma %*% w))
rc /sum(rc)
rc
})
# plots
<- df_w |>
p_w 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") +
labs(title = "Portfolio weights", x = NULL, y = "weight")
<- df_rrc |>
p_rrc 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") +
labs(title = "Relative risk contribution", y = "risk")
/ p_rrc + plot_layout(guides = "collect")
p_w
}
barplot_w_and_RCC(df_w, Sigma)
Naive diagonal formulation
Portfolio allocation and risk contribution of the \(1/N\) portfolio and naive RPP:
library(pob)
library(riskParityPortfolio)
<- SP500_2015to2020$stocks["2020::2020-09", c("AAPL", "NFLX", "TSCO", "MGM", "MSFT", "FB", "AMZN", "GOOGL")]
stock_prices <- nrow(stock_prices)
T <- round(0.70*T)
T_trn <- diff(log(stock_prices[1:T_trn, ]))[-1]
X <- cov(X)
Sigma <- ncol(X)
N
# portfolios
<- rep(1/N, N)
w_EWP #w_naive_RPP <- riskParityPortfolio(Sigma, formulation = "diag")$w
<- 1/sqrt(diag(Sigma))
w_naive_RPP <- w_naive_RPP/sum(w_naive_RPP)
w_naive_RPP
# barplots
<- data.frame(
df_w "stocks" = names(stock_prices),
"1/N" = w_EWP,
"Naive diagonal RPP" = w_naive_RPP,
check.names = FALSE)
barplot_w_and_RCC(df_w, Sigma)