Week 13: Code along 12
CHAPTER 10 Component Contribution to Standard Deviation
Andrew Byrne
2025-10-17
# Load packages
# Core
library(tidyverse)
library(tidyquant)
library(readr)
# Time series
library(lubridate)
library(tibbletime)
# modeling
library(broom)Goal
Examine how each asset contributes to portfolio standard deviation. This is to ensure that our risk is not concentrated in any one asset.
five stocks: “SPY”, “EFA”, “IJS”, “EEM”, “AGG” from 2012-12-31 to 2017-12-31
1 Import stock prices
symbols <- c("SPY", "EFA", "IJS", "EEM", "AGG")
prices <- tq_get(x = symbols,
get = "stock.prices",
from = "2012-12-31",
to = "2017-12-31")2 Convert prices to returns
asset_returns_tbl <- prices %>%
group_by(symbol) %>%
tq_transmute(select = adjusted,
mutate_fun = periodReturn,
period = "monthly",
type = "log") %>%
slice(-1) %>%
ungroup() %>%
set_names(c("asset", "date", "returns"))3 Component Contribution Step-by-Step
Refresh your memory on covariance with this video. Click this link Refresh your memory on matrix multiplication. Click this link
# Transform data into wide form
asset_returns_wide_tbl <- asset_returns_tbl %>%
pivot_wider(names_from = asset, values_from = returns) %>%
column_to_rownames(var = "date")
asset_returns_wide_tbl## AGG EEM EFA IJS SPY
## 2013-01-31 -0.0062305154 -0.0029357123 0.0366064100 0.052133096 4.992323e-02
## 2013-02-28 0.0058907676 -0.0231049994 -0.0129696638 0.016175558 1.267824e-02
## 2013-03-28 0.0009849123 -0.0102351118 0.0129696638 0.040257983 3.726781e-02
## 2013-04-30 0.0096391014 0.0120844272 0.0489675324 0.001222127 1.903029e-02
## 2013-05-31 -0.0202136029 -0.0494832306 -0.0306554118 0.041976505 2.333537e-02
## 2013-06-28 -0.0157783258 -0.0547283441 -0.0271444336 -0.001403001 -1.343478e-02
## 2013-07-31 0.0026882948 0.0131596708 0.0518603012 0.063541717 5.038618e-02
## 2013-08-30 -0.0082986681 -0.0257055134 -0.0197462401 -0.034743475 -3.045122e-02
## 2013-09-30 0.0111432449 0.0695888937 0.0753384280 0.063873616 3.115558e-02
## 2013-10-31 0.0082926837 0.0408614090 0.0320815751 0.034233991 4.526674e-02
## 2013-11-29 -0.0025094239 -0.0025940755 0.0054496820 0.041661246 2.920722e-02
## 2013-12-31 -0.0055832353 -0.0040748255 0.0215281691 0.012892212 2.559605e-02
## 2014-01-31 0.0152915853 -0.0903222373 -0.0534136012 -0.035775219 -3.588487e-02
## 2014-02-28 0.0037562629 0.0332202932 0.0595052560 0.045256847 4.451017e-02
## 2014-03-31 -0.0014813629 0.0380218828 -0.0046025730 0.013315798 8.261602e-03
## 2014-04-30 0.0081832614 0.0077727917 0.0165293438 -0.023184514 6.927656e-03
## 2014-05-30 0.0117212696 0.0290909579 0.0158285994 0.006205532 2.294136e-02
## 2014-06-30 -0.0005753668 0.0237338322 0.0091654915 0.037718647 2.043454e-02
## 2014-07-31 -0.0025120605 0.0135556904 -0.0263799645 -0.052009577 -1.352879e-02
## 2014-08-29 0.0114305281 0.0279046107 0.0018003196 0.043657946 3.870478e-02
## 2014-09-30 -0.0061672594 -0.0808569058 -0.0395982980 -0.061260732 -1.389218e-02
## 2014-10-31 0.0105842710 0.0140968075 -0.0026549334 0.068875138 2.327807e-02
## 2014-11-28 0.0065493617 -0.0155412082 0.0006252476 0.004773573 2.710086e-02
## 2014-12-31 0.0014749714 -0.0404424799 -0.0407465623 0.025295756 -2.539291e-03
## 2015-01-30 0.0203151709 -0.0068953903 0.0062263657 -0.054627648 -3.007737e-02
## 2015-02-27 -0.0089881166 0.0431357268 0.0614507473 0.056914291 5.468214e-02
## 2015-03-31 0.0037398012 -0.0150857677 -0.0143887109 0.010156240 -1.583049e-02
## 2015-04-30 -0.0032328691 0.0662810603 0.0358163396 -0.018417422 9.785874e-03
## 2015-05-29 -0.0043839035 -0.0419109266 0.0019528671 0.007509861 1.277442e-02
## 2015-06-30 -0.0108249541 -0.0297467055 -0.0316790783 0.004171436 -2.052132e-02
## 2015-07-31 0.0085843138 -0.0651781505 0.0201146545 -0.027375346 2.233767e-02
## 2015-08-31 -0.0033634145 -0.0925121983 -0.0771525835 -0.047268512 -6.288654e-02
## 2015-09-30 0.0080811610 -0.0318251018 -0.0451948496 -0.038464928 -2.584716e-02
## 2015-10-30 0.0006855449 0.0618084200 0.0640258283 0.063589941 8.163498e-02
## 2015-11-30 -0.0038986275 -0.0255604733 -0.0075555607 0.024414961 3.648421e-03
## 2015-12-31 -0.0019185322 -0.0389472098 -0.0235952201 -0.052156529 -1.743377e-02
## 2016-01-29 0.0123297456 -0.0516364737 -0.0567578828 -0.060307150 -5.106861e-02
## 2016-02-29 0.0088310470 -0.0082115365 -0.0339137399 0.020605474 -8.264292e-04
## 2016-03-31 0.0087095891 0.1218788047 0.0637455737 0.089910135 6.510027e-02
## 2016-04-29 0.0025464749 0.0040793096 0.0219751912 0.021044169 3.933603e-03
## 2016-05-31 0.0001351525 -0.0376286031 -0.0008562581 0.004397104 1.686859e-02
## 2016-06-30 0.0191668910 0.0445825631 -0.0244913520 0.008292475 3.469845e-03
## 2016-07-29 0.0054298555 0.0524421594 0.0390001532 0.049348208 3.582208e-02
## 2016-08-31 -0.0021565272 0.0087982149 0.0053268450 0.011261416 1.196647e-03
## 2016-09-30 0.0005160424 0.0248733585 0.0132790797 0.008614451 5.802546e-05
## 2016-10-31 -0.0082051899 -0.0083123878 -0.0224037536 -0.038134886 -1.748881e-02
## 2016-11-30 -0.0259892560 -0.0451620805 -0.0179744034 0.125246272 3.617575e-02
## 2016-12-30 0.0025376051 -0.0025297207 0.0267029049 0.031491871 2.006914e-02
## 2017-01-31 0.0021258571 0.0644310434 0.0323819966 -0.012143704 1.773641e-02
## 2017-02-28 0.0064382295 0.0172580235 0.0118364314 0.013428707 3.853933e-02
## 2017-03-31 -0.0005527705 0.0361889211 0.0318056710 -0.006532995 1.249047e-03
## 2017-04-28 0.0090294318 0.0168665265 0.0239520989 0.005107702 9.877156e-03
## 2017-05-31 0.0068467389 0.0280600145 0.0348103721 -0.022862738 1.401449e-02
## 2017-06-30 -0.0001824771 0.0092235499 0.0029557779 0.029151706 6.354650e-03
## 2017-07-31 0.0033340544 0.0565947503 0.0261880279 0.007481282 2.034580e-02
## 2017-08-31 0.0093697687 0.0232437140 -0.0004482871 -0.027564214 2.913639e-03
## 2017-09-29 -0.0057323509 -0.0004462597 0.0233427407 0.082321610 1.994899e-02
## 2017-10-31 0.0009779146 0.0322785999 0.0166535828 0.005915982 2.329068e-02
## 2017-11-30 -0.0014841472 -0.0038972173 0.0068702379 0.036913713 3.010802e-02
## 2017-12-29 0.0047404246 0.0369255226 0.0133981379 -0.003731752 1.205501e-02# Covariance of asset returns
covariance_matrix <- cov(asset_returns_wide_tbl)
covariance_matrix## AGG EEM EFA IJS SPY
## AGG 7.398256e-05 0.0001042117 4.178214e-05 -7.811755e-05 -9.029554e-06
## EEM 1.042117e-04 0.0017547082 1.039015e-03 6.437722e-04 6.795424e-04
## EFA 4.178214e-05 0.0010390147 1.064238e-03 6.490298e-04 6.975418e-04
## IJS -7.811755e-05 0.0006437722 6.490298e-04 1.565449e-03 8.290250e-04
## SPY -9.029554e-06 0.0006795424 6.975418e-04 8.290250e-04 7.408301e-04# Standard deviation of portfolio
# Summarizes how much each asset's returns vary with those of other assets within the portfolio into a single number
w <- c(0.25, 0.25, 0.2, 0.2, 0.1)
sd_portfolio <- sqrt(t(w) %*% covariance_matrix %*% w)
sd_portfolio## [,1]
## [1,] 0.02347491# Component contribution
# Similar to the formula for sd_portfolio
# Mathematical trick to summarize the same, sd_portfolio, by asset instead of a single number
component_contribution <- (t(w) %*% covariance_matrix * w) / sd_portfolio[1,1]
component_contribution## AGG EEM EFA IJS SPY
## [1,] 0.0003874193 0.009257136 0.005815631 0.005684469 0.002330252rowSums(component_contribution)## [1] 0.02347491# Component contribution in percentage
component_percentages <- (component_contribution / sd_portfolio[1,1]) %>%
round(3) %>%
as_tibble()
component_percentages## # A tibble: 1 × 5
## AGG EEM EFA IJS SPY
## <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 0.017 0.394 0.248 0.242 0.099component_percentages %>%
as_tibble() %>%
gather(key = "asset", value = "contribution")## # A tibble: 5 × 2
## asset contribution
## <chr> <dbl>
## 1 AGG 0.017
## 2 EEM 0.394
## 3 EFA 0.248
## 4 IJS 0.242
## 5 SPY 0.0994 Component Contribution with a Custom Function
# Transform data into wide form
asset_returns_wide_tbl <- asset_returns_tbl %>%
pivot_wider(names_from = asset, values_from = returns) %>%
column_to_rownames(var = "date")
# Custom function
calculate_component_contribution <- function(asset_returns_wide_tbl, w) {
# Covariance of asset returns
covariance_matrix <- cov(asset_returns_wide_tbl)
# Standard deviation of portfolio
sd_portfolio <- sqrt(t(w) %*% covariance_matrix %*% w)
# Component contribution
component_contribution <- (t(w) %*% covariance_matrix * w) / sd_portfolio[1,1]
# Component contribution in percentage
component_percentages <- (component_contribution / sd_portfolio[1,1]) %>%
round(3) %>%
as_tibble()
return(component_percentages)
}
asset_returns_wide_tbl %>% calculate_component_contribution(w = c(0.25,0.25,0.2,0.2,0.1))## # A tibble: 1 × 5
## AGG EEM EFA IJS SPY
## <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 0.017 0.394 0.248 0.242 0.0995 Visualizing Component Contribution
# Figure 10.1 Contribution to Standard Deviation ----
asset_returns_wide_tbl %>%
calculate_component_contribution(w = c(0.25,0.25,0.2,0.2,0.1)) %>%
gather(key = "asset", value = "contribution") %>%
ggplot(aes(asset, contribution)) +
geom_col(fill = "cornflowerblue") +
theme(plot.title = element_text(hjust = 0.5)) +
scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
labs(title = "Percent Contribution to Portfolio Standard Deviation",
y = "Percent Contribution to Risk",
x = NULL)
# Figure 10.2 Weight versus Contribution ----
asset_returns_wide_tbl %>%
calculate_component_contribution(w = c(0.25,0.25,0.2,0.2,0.1)) %>%
gather(key = "asset", value = "contribution") %>%
add_column(weights = c(0.25,0.25,0.2,0.2,0.1)) %>%
pivot_longer(cols = c(contribution, weights), names_to = "type", values_to = "value") %>%
ggplot(aes(asset, value, fill = type)) +
geom_col(position = "dodge") +
theme(plot.title = element_text(hjust = 0.5)) +
scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
theme_tq() +
scale_fill_tq() +
labs(title = "Percent Contribution to Volatility",
y = "percent",
x = "asset") 
6 Rolling Component Contribution
calculate_comp_contrib_by_window <- function(asset_returns_wide_tbl,
start = 1,
window = 24,
weights) {
# 1 Define start date
start_date <- rownames(asset_returns_wide_tbl)[start]
# 2 Define end date
end_date <- rownames(asset_returns_wide_tbl)[start + window]
# 3 Subset df
df_subset <- asset_returns_wide_tbl %>%
rownames_to_column(var = "date") %>%
filter(date >= start_date & date < end_date) %>%
column_to_rownames(var = "date")
# 4 Calculate component contribution
component_percentages <-df_subset %>%
calculate_component_contribution(w = weights)
# 5 Add end date to df
component_percentages %>%
mutate(date = ymd(end_date)) %>%
select(date, everything())
}
# Check the custom function
asset_returns_wide_tbl %>% calculate_comp_contrib_by_window(start = 1, window = 24,
w = c(0.25,0.25,0.2,0.2,0.1))## # A tibble: 1 × 6
## date AGG EEM EFA IJS SPY
## <date> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 2015-01-30 0.039 0.372 0.256 0.245 0.088asset_returns_wide_tbl %>% calculate_comp_contrib_by_window(start = 2, window = 24,
w = c(0.25,0.25,0.2,0.2,0.1))## # A tibble: 1 × 6
## date AGG EEM EFA IJS SPY
## <date> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 2015-02-27 0.036 0.374 0.249 0.252 0.089dump(list = c("calculate_component_contribution",
"calculate_comp_contrib_by_window"),
file = "../00_scripts/calculate_comp_contrib_to_portfolio_volatility.R")# Iterate the custom function
w <- c(0.25,0.25,0.2,0.2,0.1)
window <- 24
rolling_comp_contrib_tbl <- 1:(nrow(asset_returns_wide_tbl) - window) %>%
map_df(.x = ., .f = ~calculate_comp_contrib_by_window(asset_returns_wide_tbl,
start = .x,
weights = w,
window = window))
rolling_comp_contrib_tbl## # A tibble: 36 × 6
## date AGG EEM EFA IJS SPY
## <date> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 2015-01-30 0.039 0.372 0.256 0.245 0.088
## 2 2015-02-27 0.036 0.374 0.249 0.252 0.089
## 3 2015-03-31 0.027 0.37 0.255 0.255 0.092
## 4 2015-04-30 0.027 0.372 0.256 0.252 0.093
## 5 2015-05-29 0.024 0.385 0.254 0.246 0.092
## 6 2015-06-30 0.018 0.383 0.248 0.257 0.094
## 7 2015-07-31 0.014 0.375 0.253 0.261 0.097
## 8 2015-08-31 0.013 0.404 0.237 0.257 0.09
## 9 2015-09-30 0.012 0.407 0.248 0.238 0.094
## 10 2015-10-30 0.003 0.405 0.244 0.243 0.105
## # ℹ 26 more rows# Figure 10.3 Component Contribution ggplot ----
rolling_comp_contrib_tbl %>%
# Transform data to long form
pivot_longer(cols = -date, names_to = "asset", values_to = "contribution") %>%
# Plot
ggplot(aes(date, contribution, color = asset)) +
geom_line() +
scale_x_date(breaks = scales::pretty_breaks(n = 7)) +
scale_y_continuous(labels = scales::percent_format()) +
annotate(geom = "text",
x = as.Date("2016-07-01"),
y = 0.03,
color = "red", size = 5,
label = str_glue("AGG dips below zero sometimes, indicating
it reduces the portfolio volatility."))
# Figure 10.4 Stacked Component Contribution ggplot ----
rolling_comp_contrib_tbl %>%
# Transform data to long form
pivot_longer(cols = -date, names_to = "asset", values_to = "contribution") %>%
# Plot
ggplot(aes(date, contribution, fill = asset)) +
geom_area() +
scale_x_date(breaks = scales::pretty_breaks(n = 7)) +
scale_y_continuous(labels = scales::percent_format()) +
annotate(geom = "text",
x = as.Date("2016-07-01"),
y = 0.08,
color = "red", size = 5,
label = str_glue("AGG dips below zero sometimes, indicating
it reduces the portfolio volatility."))