[This article was first published on R Views, and kindly contributed to R-bloggers]. (You can report issue about the content on this page here)
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.

In our previous portfolio volatility work, we covered how to import stock prices, convert to returns and set weights, calculate portfolio volatility, and calculate rolling portfolio volatility.

Now we want to break that total portfolio volatility into its constituent parts and investigate how each asset contributes to the volatility. Why might we want to do that?

For our own risk management purposes, we might want to ensure that our risk isn’t too concentrated in one asset. Not only might this lead to a less-diversified portfolio than we thought we had, but it also might indicate that our initial assumptions about a particular asset were wrong – or, at least, they have become less right as the asset has changed over time.

Similarly, if this portfolio is governed by a mandate from, say, an institutional client, that client might have a preference or even a rule that no asset or sector can rise above a certain threshold of risk contribution. That institutional client might require a report like this from each of their outsourced managers, so they can sum the constituents.

With that motivation in mind, let’s get prices, returns, and set weights for five ETFs.

library(timetk)
library(tidyverse)
library(tidyquant)
library(highcharter)

symbols <- c("SPY","IJS","EFA","EEM","AGG")

prices <-
getSymbols(symbols, src = 'google', from = "2005-01-01",
auto.assign = TRUE, warnings = FALSE) %>%
map(~Cl(get(.))) %>%
reduce(merge) %>%
colnames<-(symbols)

prices_monthly <- to.monthly(prices, indexAt = "first", OHLC = FALSE)

portfolioComponentReturns <- na.omit(Return.calculate(prices_monthly, method = "log"))

w = c(0.25, 0.20, 0.20, 0.25, 0.10)

We need to build the covariance matrix and calculate portfolio standard deviation.

covariance_matrix <- cov(portfolioComponentReturns)

# Square root of transpose of the weights cross prod covariance matrix returns
# cross prod weights gives portfolio standard deviation.
sd_portfolio <- sqrt(t(w) %*% covariance_matrix %*% w)

Let’s start to look at the individual components.

The percentage contribution of asset i is defined as:

(marginal contribution of asset i * weight of asset i) / portfolio standard deviation

To find the marginal contribution of each asset, take the cross-product of the weights vector and the covariance matrix divided by the portfolio standard deviation.

# Marginal contribution of each asset.
marginal_contribution <- w %*% covariance_matrix / sd_portfolio[1, 1]

Now multiply the marginal contribution of each asset by the weights vector to get total contribution. We can then sum the asset contributions and make sure it’s equal to the total portfolio standard deviation.

# Component contributions to risk are the weighted marginal contributions
component_contribution <- marginal_contribution * w

# This should equal total portfolio vol, or the object sd_portfolio
components_summed <- rowSums(component_contribution)

The summed components are 0.0448135 and the matrix calculation is 0.0448135.

To get to percentage contribution of each asset, we divide each asset’s contribution by the total portfolio standard deviation.

# To get the percentage contribution, divide component contribution by total sd.
component_percentages <- component_contribution / sd_portfolio[1, 1]

Let’s port this to a tibble for ease of presentation, and we’ll append by_hand to the object because we did the calculations step-by-step.

percentage_tibble_by_hand <-
tibble(symbols, w, as.vector(component_percentages)) %>%
rename(asset = symbols, 'portfolio weight' = w, 'risk contribution' = as.vector(component_percentages))

percentage_tibble_by_hand
## # A tibble: 5 x 3
##   asset portfolio weight risk contribution
##
## 1   SPY               0.25         0.213569366
## 2   IJS               0.20         0.213310709
## 3   EFA               0.20         0.220213245
## 4   EEM               0.25         0.349901018
## 5   AGG               0.10         0.003005661

As you might have guessed, we used by_hand in the object name because we could have used a pre-built R function to do all this work.

The StdDev function from PerformanceAnalytics will run this same calculation if we pass in the weights and set portfolio_method = "component" (recall that if we set portfolio_method = "single", the function will return the total portfolio standard deviation, as we saw in our previous work).

Let’s confirm that the pre-built function returns the same results.

# Confirm component contribution to volality.
component_sd_pre_built <- StdDev(portfolioComponentReturns, weights = w,
portfolio_method = "component")
component_sd_pre_built
## $StdDev ## [,1] ## [1,] 0.04481354 ## ##$contribution
##          SPY          IJS          EFA          EEM          AGG
## 0.0095707991 0.0095592078 0.0098685349 0.0156803030 0.0001346943
##
## $pct_contrib_StdDev ## SPY IJS EFA EEM AGG ## 0.213569366 0.213310709 0.220213245 0.349901018 0.003005661 That function returns a list, and one of the elements is $pct_contrib_StdDev, which is the percentage contribution of each asset. Let’s move it to a tibble for ease of presentation.

# Port to a tibble.
percentages_tibble_pre_built <-
component_sd_pre_built$pct_contrib_StdDev %>% tk_tbl(preserve_row_names = FALSE) %>% mutate(asset = symbols) %>% rename('risk contribution' = data) %>% select(asset, everything(), -index) Has our work checked out? Is percentages_tibble_pre_built showing the same result as component_percentages_tibble_by_hand? Compare the two objects percentages_tibble_pre_built ## # A tibble: 5 x 2 ## asset risk contribution ## ## 1 SPY 0.213569366 ## 2 IJS 0.213310709 ## 3 EFA 0.220213245 ## 4 EEM 0.349901018 ## 5 AGG 0.003005661 percentage_tibble_by_hand ## # A tibble: 5 x 3 ## asset portfolio weight risk contribution ## ## 1 SPY 0.25 0.213569366 ## 2 IJS 0.20 0.213310709 ## 3 EFA 0.20 0.220213245 ## 4 EEM 0.25 0.349901018 ## 5 AGG 0.10 0.003005661 Huzzah - our findings seem to be consistent! While we have the tibbles in front of us, notice that EEM has a 25% weight but contributes 35% to the volatility. That’s not necessarily a bad thing, but we should be aware of it. Our substantive work is done, but let’s turn to ggplot for some visualization. component_percent_plot <- ggplot(percentage_tibble_by_hand, aes(asset, risk contribution)) + geom_col(fill = 'blue', colour = 'red') + scale_y_continuous(labels = scales::percent) + ggtitle("Percent Contribution to Volatility", subtitle = "") + theme(plot.title = element_text(hjust = 0.5)) + theme(plot.subtitle = element_text(hjust = 0.5)) + xlab("Asset") + ylab("Percent Contribution to Risk") component_percent_plot How about a chart that compares weights to risk contribution? First we’ll need to gather our tibble to long format, then call ggplot. # gather percentage_tibble_by_hand_gather <- percentage_tibble_by_hand %>% gather(type, percent, -asset) # built ggplot object plot_compare_weight_contribution <- ggplot(percentage_tibble_by_hand_gather, aes(x = asset, y = percent, fill = type)) + geom_col(position = 'dodge') + scale_y_continuous(labels = scales::percent) + ggtitle("Percent Contribution to Volatility", subtitle = "") + theme(plot.title = element_text(hjust = 0.5)) + theme(plot.subtitle = element_text(hjust = 0.5)) plot_compare_weight_contribution It looks like AGG, a bond fund, has done a good job as a volatility dampener. It has a 10% allocation but contributes almost zero to volatility. We’re ignoring returns for now. The largest contributor to the portfolio volatility has been EEM, an emerging market ETF, but have a look at the EEM chart and note that it’s own absolute volatility has been quite low. EEM_sd <- StdDev(portfolioComponentReturns$EEM)

EEM_sd_overtime <-
round(rollapply(portfolioComponentReturns\$EEM, 20, function(x) StdDev(x)), 4) * 100

highchart(type = "stock") %>%
hc_title(text = "EEM Volatility") %>%
hc_add_series(EEM_sd_overtime, name = "EEM Vol") %>%
hc_yAxis(labels = list(format = "{value}%"), opposite = FALSE) %>%
hc_navigator(enabled = FALSE) %>%
hc_scrollbar(enabled = FALSE)

EEM has contributed 35% to portfolio volatility, but it hasn’t been very risky over this time period. It’s standard deviation has been 0.0671957. Yet, it is still the riskiest asset in our portfolio. Perhaps this is a safe portfolio? Or perhaps we are in a period of very low volatility (indeed, that is the case according to the VIX and actual realized volatility).

That’s all for today. See you next time.

To leave a comment for the author, please follow the link and comment on their blog: R Views.

R-bloggers.com offers daily e-mail updates about R news and tutorials about learning R and many other topics. Click here if you're looking to post or find an R/data-science job.
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.

# Never miss an update! Subscribe to R-bloggers to receive e-mails with the latest R posts.(You will not see this message again.)

Click here to close (This popup will not appear again)