Week 14: Code along 12
CHAPTER 10 Component Contribution to Standard Deviation
Brody DeMasi
2025-06-23
# 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.0062315825 -0.0029353724 0.0366062228 0.052133273 4.992296e-02
## 2013-02-28 0.0058913045 -0.0231054615 -0.0129691922 0.016175115 1.267844e-02
## 2013-03-28 0.0009847030 -0.0102347632 0.0129691922 0.040258438 3.726811e-02
## 2013-04-30 0.0096394999 0.0120845432 0.0489676305 0.001222111 1.902988e-02
## 2013-05-31 -0.0202143812 -0.0494833466 -0.0306554146 0.041976606 2.333526e-02
## 2013-06-28 -0.0157774506 -0.0547283441 -0.0271445305 -0.001402900 -1.343399e-02
## 2013-07-31 0.0026873353 0.0131597978 0.0518604901 0.063541310 5.038571e-02
## 2013-08-30 -0.0082979206 -0.0257053798 -0.0197463316 -0.034743077 -3.045141e-02
## 2013-09-30 0.0111435943 0.0695885722 0.0753386042 0.063873287 3.115594e-02
## 2013-10-31 0.0082924887 0.0408613531 0.0320814903 0.034234177 4.526657e-02
## 2013-11-29 -0.0025101991 -0.0025940758 0.0054496003 0.041661296 2.920699e-02
## 2013-12-31 -0.0055833299 -0.0040742386 0.0215281708 0.012892107 2.559628e-02
## 2014-01-31 0.0152921319 -0.0903228359 -0.0534132683 -0.035775256 -3.588421e-02
## 2014-02-28 0.0037568177 0.0332204218 0.0595050824 0.045257194 4.451036e-02
## 2014-03-31 -0.0014820165 0.0380218828 -0.0046027323 0.013315150 8.261160e-03
## 2014-04-30 0.0081836009 0.0077730294 0.0165294236 -0.023184109 6.927178e-03
## 2014-05-30 0.0117210525 0.0290908357 0.0158285221 0.006205217 2.294102e-02
## 2014-06-30 -0.0005750352 0.0237338294 0.0091651094 0.037718572 2.043502e-02
## 2014-07-31 -0.0025119447 0.0135556888 -0.0263794264 -0.052009114 -1.352898e-02
## 2014-08-29 0.0114302134 0.0279048239 0.0018004765 0.043657861 3.870492e-02
## 2014-09-30 -0.0061670947 -0.0808567612 -0.0395986151 -0.061260681 -1.389211e-02
## 2014-10-31 0.0105842966 0.0140963385 -0.0026546880 0.068874897 2.327758e-02
## 2014-11-28 0.0065494102 -0.0155413256 0.0006250839 0.004773682 2.710134e-02
## 2014-12-31 0.0014746239 -0.0404420568 -0.0407466475 0.025295841 -2.539905e-03
## 2015-01-30 0.0203151027 -0.0068958806 0.0062266203 -0.054627950 -3.007705e-02
## 2015-02-27 -0.0089882021 0.0431361473 0.0614504983 0.056914529 5.468185e-02
## 2015-03-31 0.0037404936 -0.0150859436 -0.0143887121 0.010156803 -1.583009e-02
## 2015-04-30 -0.0032333677 0.0662811125 0.0358163424 -0.018417977 9.785824e-03
## 2015-05-29 -0.0043830504 -0.0419109218 0.0019528673 0.007509827 1.277439e-02
## 2015-06-30 -0.0108254759 -0.0297468223 -0.0316788399 0.004171519 -2.052151e-02
## 2015-07-31 0.0085840751 -0.0651780220 0.0201142578 -0.027375101 2.233800e-02
## 2015-08-31 -0.0033633804 -0.0925123972 -0.0771521774 -0.047268658 -6.288657e-02
## 2015-09-30 0.0080813155 -0.0318248859 -0.0451950196 -0.038464999 -2.584731e-02
## 2015-10-30 0.0006854546 0.0618082745 0.0640259117 0.063589906 8.163502e-02
## 2015-11-30 -0.0038985687 -0.0255604733 -0.0075556441 0.024415062 3.648535e-03
## 2015-12-31 -0.0019189355 -0.0389472098 -0.0235951340 -0.052156774 -1.743361e-02
## 2016-01-29 0.0123303986 -0.0516364737 -0.0567576956 -0.060307215 -5.106872e-02
## 2016-02-29 0.0088314755 -0.0082116913 -0.0339142016 0.020605846 -8.260854e-04
## 2016-03-31 0.0087086664 0.1218791652 0.0637457622 0.089909899 6.509999e-02
## 2016-04-29 0.0025466291 0.0040791040 0.0219751047 0.021044202 3.933278e-03
## 2016-05-31 0.0001352598 -0.0376286031 -0.0008559119 0.004397242 1.686869e-02
## 2016-06-30 0.0191666711 0.0445823597 -0.0244915230 0.008292317 3.469657e-03
## 2016-07-29 0.0054299620 0.0524422341 0.0390001498 0.049348123 3.582231e-02
## 2016-08-31 -0.0021564906 0.0087984073 0.0053268445 0.011261164 1.196927e-03
## 2016-09-30 0.0005161020 0.0248729838 0.0132792461 0.008614774 5.770203e-05
## 2016-10-31 -0.0082056069 -0.0083120141 -0.0224037479 -0.038134943 -1.748905e-02
## 2016-11-30 -0.0259896967 -0.0451619464 -0.0179745731 0.125246493 3.617591e-02
## 2016-12-30 0.0025380017 -0.0025298517 0.0267028177 0.031491560 2.006932e-02
## 2017-01-31 0.0021260518 0.0644314093 0.0323819966 -0.012143813 1.773632e-02
## 2017-02-28 0.0064386068 0.0172577737 0.0118365126 0.013428737 3.853930e-02
## 2017-03-31 -0.0005534073 0.0361890901 0.0318054324 -0.006532992 1.249297e-03
## 2017-04-28 0.0090295247 0.0168664057 0.0239525635 0.005107739 9.877098e-03
## 2017-05-31 0.0068474046 0.0280596727 0.0348099164 -0.022862584 1.401425e-02
## 2017-06-30 -0.0001828383 0.0092237724 0.0029560003 0.029151902 6.354587e-03
## 2017-07-31 0.0033344931 0.0565946395 0.0261879539 0.007481293 2.034613e-02
## 2017-08-31 0.0093689629 0.0232436118 -0.0004484313 -0.027564461 2.913382e-03
## 2017-09-29 -0.0057322069 -0.0004459528 0.0233428849 0.082321473 1.994893e-02
## 2017-10-31 0.0009778852 0.0322783953 0.0166537213 0.005916520 2.329086e-02
## 2017-11-30 -0.0014840338 -0.0038971178 0.0068697554 0.036913088 3.010790e-02
## 2017-12-29 0.0047401184 0.0369255190 0.0133984819 -0.003731056 1.205512e-02# Covariance of asset returns
covariance_matrix <- cov(asset_returns_wide_tbl)
covariance_matrix## AGG EEM EFA IJS SPY
## AGG 7.398395e-05 0.0001042065 4.178029e-05 -7.812292e-05 -9.033552e-06
## EEM 1.042065e-04 0.0017547102 1.039016e-03 6.437721e-04 6.795412e-04
## EFA 4.178029e-05 0.0010390161 1.064236e-03 6.490280e-04 6.975394e-04
## IJS -7.812292e-05 0.0006437721 6.490280e-04 1.565447e-03 8.290239e-04
## SPY -9.033552e-06 0.0006795412 6.975394e-04 8.290239e-04 7.408284e-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.02347487# 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.0003873901 0.009257143 0.00581563 0.00568446 0.002330247rowSums(component_contribution)## [1] 0.02347487# 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")
asset_returns_wide_tbl## AGG EEM EFA IJS SPY
## 2013-01-31 -0.0062315825 -0.0029353724 0.0366062228 0.052133273 4.992296e-02
## 2013-02-28 0.0058913045 -0.0231054615 -0.0129691922 0.016175115 1.267844e-02
## 2013-03-28 0.0009847030 -0.0102347632 0.0129691922 0.040258438 3.726811e-02
## 2013-04-30 0.0096394999 0.0120845432 0.0489676305 0.001222111 1.902988e-02
## 2013-05-31 -0.0202143812 -0.0494833466 -0.0306554146 0.041976606 2.333526e-02
## 2013-06-28 -0.0157774506 -0.0547283441 -0.0271445305 -0.001402900 -1.343399e-02
## 2013-07-31 0.0026873353 0.0131597978 0.0518604901 0.063541310 5.038571e-02
## 2013-08-30 -0.0082979206 -0.0257053798 -0.0197463316 -0.034743077 -3.045141e-02
## 2013-09-30 0.0111435943 0.0695885722 0.0753386042 0.063873287 3.115594e-02
## 2013-10-31 0.0082924887 0.0408613531 0.0320814903 0.034234177 4.526657e-02
## 2013-11-29 -0.0025101991 -0.0025940758 0.0054496003 0.041661296 2.920699e-02
## 2013-12-31 -0.0055833299 -0.0040742386 0.0215281708 0.012892107 2.559628e-02
## 2014-01-31 0.0152921319 -0.0903228359 -0.0534132683 -0.035775256 -3.588421e-02
## 2014-02-28 0.0037568177 0.0332204218 0.0595050824 0.045257194 4.451036e-02
## 2014-03-31 -0.0014820165 0.0380218828 -0.0046027323 0.013315150 8.261160e-03
## 2014-04-30 0.0081836009 0.0077730294 0.0165294236 -0.023184109 6.927178e-03
## 2014-05-30 0.0117210525 0.0290908357 0.0158285221 0.006205217 2.294102e-02
## 2014-06-30 -0.0005750352 0.0237338294 0.0091651094 0.037718572 2.043502e-02
## 2014-07-31 -0.0025119447 0.0135556888 -0.0263794264 -0.052009114 -1.352898e-02
## 2014-08-29 0.0114302134 0.0279048239 0.0018004765 0.043657861 3.870492e-02
## 2014-09-30 -0.0061670947 -0.0808567612 -0.0395986151 -0.061260681 -1.389211e-02
## 2014-10-31 0.0105842966 0.0140963385 -0.0026546880 0.068874897 2.327758e-02
## 2014-11-28 0.0065494102 -0.0155413256 0.0006250839 0.004773682 2.710134e-02
## 2014-12-31 0.0014746239 -0.0404420568 -0.0407466475 0.025295841 -2.539905e-03
## 2015-01-30 0.0203151027 -0.0068958806 0.0062266203 -0.054627950 -3.007705e-02
## 2015-02-27 -0.0089882021 0.0431361473 0.0614504983 0.056914529 5.468185e-02
## 2015-03-31 0.0037404936 -0.0150859436 -0.0143887121 0.010156803 -1.583009e-02
## 2015-04-30 -0.0032333677 0.0662811125 0.0358163424 -0.018417977 9.785824e-03
## 2015-05-29 -0.0043830504 -0.0419109218 0.0019528673 0.007509827 1.277439e-02
## 2015-06-30 -0.0108254759 -0.0297468223 -0.0316788399 0.004171519 -2.052151e-02
## 2015-07-31 0.0085840751 -0.0651780220 0.0201142578 -0.027375101 2.233800e-02
## 2015-08-31 -0.0033633804 -0.0925123972 -0.0771521774 -0.047268658 -6.288657e-02
## 2015-09-30 0.0080813155 -0.0318248859 -0.0451950196 -0.038464999 -2.584731e-02
## 2015-10-30 0.0006854546 0.0618082745 0.0640259117 0.063589906 8.163502e-02
## 2015-11-30 -0.0038985687 -0.0255604733 -0.0075556441 0.024415062 3.648535e-03
## 2015-12-31 -0.0019189355 -0.0389472098 -0.0235951340 -0.052156774 -1.743361e-02
## 2016-01-29 0.0123303986 -0.0516364737 -0.0567576956 -0.060307215 -5.106872e-02
## 2016-02-29 0.0088314755 -0.0082116913 -0.0339142016 0.020605846 -8.260854e-04
## 2016-03-31 0.0087086664 0.1218791652 0.0637457622 0.089909899 6.509999e-02
## 2016-04-29 0.0025466291 0.0040791040 0.0219751047 0.021044202 3.933278e-03
## 2016-05-31 0.0001352598 -0.0376286031 -0.0008559119 0.004397242 1.686869e-02
## 2016-06-30 0.0191666711 0.0445823597 -0.0244915230 0.008292317 3.469657e-03
## 2016-07-29 0.0054299620 0.0524422341 0.0390001498 0.049348123 3.582231e-02
## 2016-08-31 -0.0021564906 0.0087984073 0.0053268445 0.011261164 1.196927e-03
## 2016-09-30 0.0005161020 0.0248729838 0.0132792461 0.008614774 5.770203e-05
## 2016-10-31 -0.0082056069 -0.0083120141 -0.0224037479 -0.038134943 -1.748905e-02
## 2016-11-30 -0.0259896967 -0.0451619464 -0.0179745731 0.125246493 3.617591e-02
## 2016-12-30 0.0025380017 -0.0025298517 0.0267028177 0.031491560 2.006932e-02
## 2017-01-31 0.0021260518 0.0644314093 0.0323819966 -0.012143813 1.773632e-02
## 2017-02-28 0.0064386068 0.0172577737 0.0118365126 0.013428737 3.853930e-02
## 2017-03-31 -0.0005534073 0.0361890901 0.0318054324 -0.006532992 1.249297e-03
## 2017-04-28 0.0090295247 0.0168664057 0.0239525635 0.005107739 9.877098e-03
## 2017-05-31 0.0068474046 0.0280596727 0.0348099164 -0.022862584 1.401425e-02
## 2017-06-30 -0.0001828383 0.0092237724 0.0029560003 0.029151902 6.354587e-03
## 2017-07-31 0.0033344931 0.0565946395 0.0261879539 0.007481293 2.034613e-02
## 2017-08-31 0.0093689629 0.0232436118 -0.0004484313 -0.027564461 2.913382e-03
## 2017-09-29 -0.0057322069 -0.0004459528 0.0233428849 0.082321473 1.994893e-02
## 2017-10-31 0.0009778852 0.0322783953 0.0166537213 0.005916520 2.329086e-02
## 2017-11-30 -0.0014840338 -0.0038971178 0.0068697554 0.036913088 3.010790e-02
## 2017-12-29 0.0047401184 0.0369255190 0.0133984819 -0.003731056 1.205512e-02calculate_component_contribution <- function(.data, w) {
# Covariance of asset returns
covariance_matrix <- cov(.data)
# Standard deviation of portfolio
# Summarizes how much each asset's returns vary with those of other assets within the portfolio into a single number
sd_portfolio <- sqrt(t(w) %*% covariance_matrix %*% w)
# 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 in percentage
component_percentages <- (component_contribution / sd_portfolio[1,1]) %>%
round(3) %>%
as_tibble()
component_percentages
return(component_percentages)
}
asset_returns_wide_tbl %>% calculate_component_contribution(w = c(.25, .25, .2, .2, .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
Column Chart of Component Contribution
plot_data <- asset_returns_wide_tbl %>%
calculate_component_contribution(w = c(.25, .25, .2, .2, .1 )) %>%
# Tranform to long form
pivot_longer(cols = everything() ,names_to = "Asset", values_to = "Contribution")
plot_data %>%
ggplot(aes(x = Asset, y = Contribution)) +
geom_col(fill = "cornflowerblue") +
scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
theme(plot.title = element_text(hjust = .5)) +
labs(title = "Percent Contribution to Portfolio Volatility")
Column Chart of Component Contribution and Weight
plot_data <- asset_returns_wide_tbl %>%
calculate_component_contribution(w = c(.25, .25, .2, .2, .1 )) %>%
# Tranform to long form
pivot_longer(cols = everything() ,names_to = "Asset", values_to = "Contribution") %>%
# Add weights
add_column(weight = c(.25, .25, .2, .2, .1)) %>%
# Transform to long
pivot_longer(cols = c(Contribution, weight), names_to = "type" , values_to = "value")
plot_data %>%
ggplot(aes(x = Asset, y = value, fill = type)) +
geom_col(position = "dodge") +
scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
scale_fill_tq() +
theme(plot.title = element_text(hjust = .5)) +
theme_tq() +
labs(title = "Percent Contribution to Portfolio Volatility and Weight", y = "Percent",
x = NULL)