Portfolio Optimization
Chapter 11: Risk Parity Portfolios

R code

Published

October 17, 2024

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:

# 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

From dollar to risk diversification

Portfolio allocation and risk allocation for the \(1/N\) portfolio and risk parity portfolio:

library(pob)
library(riskParityPortfolio)

stock_prices <- SP500_2015to2020$stocks["2020::2020-09", c("AAPL", "NFLX", "TSCO", "MGM", "MSFT", "FB", "AMZN", "GOOGL")]
T <- nrow(stock_prices)
T_trn <- round(0.70*T)
X <- diff(log(stock_prices[1:T_trn, ]))[-1]
Sigma <- cov(X)
N <- ncol(X)


# portfolios
w_EWP <- rep(1/N, N)
w_RPP <- riskParityPortfolio(Sigma)$w

# barplots
df_w <- data.frame(
  "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:
barplot_w_and_RCC <- function(df_w, Sigma) {
  df_w$stocks <- factor(df_w$stocks, levels = unique(df_w$stocks))
  
  # get relative risk contribution
  df_rrc <- df_w
  df_rrc[-1] <- lapply(as.list(df_w[-1]), function(w) {
    rc <- as.vector(w * (Sigma %*% w))
    rc/sum(rc)
    })
  
  # plots
  p_w <- df_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")
  
  p_rrc <- df_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_w / p_rrc + plot_layout(guides = "collect")
}

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)

stock_prices <- SP500_2015to2020$stocks["2020::2020-09", c("AAPL", "NFLX", "TSCO", "MGM", "MSFT", "FB", "AMZN", "GOOGL")]
T <- nrow(stock_prices)
T_trn <- round(0.70*T)
X <- diff(log(stock_prices[1:T_trn, ]))[-1]
Sigma <- cov(X)
N <- ncol(X)


# portfolios
w_EWP <- rep(1/N, N)
#w_naive_RPP <- riskParityPortfolio(Sigma, formulation = "diag")$w
w_naive_RPP <- 1/sqrt(diag(Sigma))
w_naive_RPP <- w_naive_RPP/sum(w_naive_RPP)


# barplots
df_w <- data.frame(
  "stocks"    = names(stock_prices),
  "1/N"                = w_EWP,
  "Naive diagonal RPP" = w_naive_RPP,
  check.names = FALSE)

barplot_w_and_RCC(df_w, Sigma)