Week 14: Code along 12
CHAPTER 10 Component Contribution to Standard Deviation
Cohen Karr
2025-11-19
# 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.0062311904 -0.002935713 0.0366063094 0.052133319 4.992316e-02
## 2013-02-28 0.0058908646 -0.023105234 -0.0129695678 0.016175235 1.267805e-02
## 2013-03-28 0.0009849123 -0.010234881 0.0129695678 0.040258095 3.726818e-02
## 2013-04-30 0.0096391968 0.012084893 0.0489675280 0.001222641 1.903022e-02
## 2013-05-31 -0.0202138929 -0.049483761 -0.0306555009 0.041976291 2.333548e-02
## 2013-06-28 -0.0157787243 -0.054727904 -0.0271447168 -0.001403001 -1.343454e-02
## 2013-07-31 0.0026886907 0.013159477 0.0518604052 0.063541427 5.038559e-02
## 2013-08-30 -0.0082984709 -0.025705577 -0.0197460608 -0.034743670 -3.045099e-02
## 2013-09-30 0.0111435398 0.069588954 0.0753383432 0.063873814 3.115546e-02
## 2013-10-31 0.0082920963 0.040861232 0.0320815778 0.034233907 4.526684e-02
## 2013-11-29 -0.0025096201 -0.002594076 0.0054497641 0.041661087 2.920721e-02
## 2013-12-31 -0.0055834346 -0.004074591 0.0215280092 0.012892381 2.559585e-02
## 2014-01-31 0.0152917893 -0.090322548 -0.0534133570 -0.035775652 -3.588445e-02
## 2014-02-28 0.0037568433 0.033220424 0.0595050922 0.045257525 4.451025e-02
## 2014-03-31 -0.0014814593 0.038022304 -0.0046024936 0.013315395 8.261300e-03
## 2014-04-30 0.0081827825 0.007772314 0.0165295008 -0.023184110 6.927160e-03
## 2014-05-30 0.0117222219 0.029091192 0.0158284424 0.006205367 2.294166e-02
## 2014-06-30 -0.0005752718 0.023733942 0.0091652618 0.037718965 2.043426e-02
## 2014-07-31 -0.0025127238 0.013555576 -0.0263798134 -0.052009399 -1.352832e-02
## 2014-08-29 0.0114304353 0.027904608 0.0018003983 0.043657452 3.870477e-02
## 2014-09-30 -0.0061670716 -0.080856897 -0.0395982980 -0.061260399 -1.389227e-02
## 2014-10-31 0.0105840841 0.014096575 -0.0026548515 0.068874727 2.327752e-02
## 2014-11-28 0.0065493629 -0.015541327 0.0006253294 0.004773887 2.710150e-02
## 2014-12-31 0.0014752498 -0.040442123 -0.0407468963 0.025295676 -2.539736e-03
## 2015-01-30 0.0203147147 -0.006895513 0.0062265361 -0.054627724 -3.007747e-02
## 2015-02-27 -0.0089884866 0.043135963 0.0614506677 0.056914215 5.468242e-02
## 2015-03-31 0.0037406260 -0.015086123 -0.0143889544 0.010156543 -1.583023e-02
## 2015-04-30 -0.0032325023 0.066281292 0.0358167407 -0.018417803 9.785785e-03
## 2015-05-29 -0.0043840856 -0.041911272 0.0019527114 0.007509863 1.277416e-02
## 2015-06-30 -0.0108255093 -0.029746532 -0.0316789202 0.004171665 -2.052141e-02
## 2015-07-31 0.0085849619 -0.065177705 0.0201144955 -0.027375578 2.233828e-02
## 2015-08-31 -0.0033641537 -0.092512654 -0.0771525048 -0.047268519 -6.288698e-02
## 2015-09-30 0.0080814394 -0.031824886 -0.0451946717 -0.038464678 -2.584679e-02
## 2015-10-30 0.0006858202 0.061808343 0.0640258172 0.063590096 8.163513e-02
## 2015-11-30 -0.0038981663 -0.025560542 -0.0075558116 0.024414955 3.647900e-03
## 2015-12-31 -0.0019189923 -0.038947210 -0.0235950500 -0.052156928 -1.743350e-02
## 2016-01-29 0.0123295610 -0.051636550 -0.0567578778 -0.060306811 -5.106851e-02
## 2016-02-29 0.0088315891 -0.008211537 -0.0339140194 0.020605043 -8.265217e-04
## 2016-03-31 0.0087093157 0.121879019 0.0637458506 0.089910313 6.510043e-02
## 2016-04-29 0.0025456702 0.004079241 0.0219748433 0.021044553 3.933342e-03
## 2016-05-31 0.0001355991 -0.037628459 -0.0008557389 0.004397027 1.686834e-02
## 2016-06-30 0.0191671556 0.044582283 -0.0244916117 0.008292246 3.469931e-03
## 2016-07-29 0.0054293316 0.052442034 0.0390001532 0.049347920 3.582192e-02
## 2016-08-31 -0.0021564407 0.008798599 0.0053269298 0.011261562 1.196811e-03
## 2016-09-30 0.0005168282 0.024873105 0.0132791624 0.008614664 5.810719e-05
## 2016-10-31 -0.0082056256 -0.008312200 -0.0224037498 -0.038135029 -1.748914e-02
## 2016-11-30 -0.0259898860 -0.045162140 -0.0179746619 0.125246733 3.617624e-02
## 2016-12-30 0.0025382372 -0.002529523 0.0267032468 0.031491672 2.006898e-02
## 2017-01-31 0.0021262165 0.064431150 0.0323818240 -0.012144019 1.773664e-02
## 2017-02-28 0.0064376013 0.017257654 0.0118362680 0.013428646 3.853903e-02
## 2017-03-31 -0.0005528600 0.036189155 0.0318055161 -0.006532871 1.249196e-03
## 2017-04-28 0.0090292571 0.016866523 0.0239526422 0.005107452 9.877155e-03
## 2017-05-31 0.0068471818 0.028059785 0.0348099164 -0.022862425 1.401449e-02
## 2017-06-30 -0.0001822132 0.009223661 0.0029560003 0.029151954 6.354649e-03
## 2017-07-31 0.0033344043 0.056594326 0.0261878819 0.007481218 2.034594e-02
## 2017-08-31 0.0093688942 0.023244130 -0.0004482871 -0.027564273 2.913216e-03
## 2017-09-29 -0.0057324398 -0.000446055 0.0233429537 0.082321483 1.994921e-02
## 2017-10-31 0.0009780896 0.032278392 0.0166534419 0.005915982 2.329088e-02
## 2017-11-30 -0.0014836230 -0.003897316 0.0068700315 0.036913152 3.010775e-02
## 2017-12-29 0.0047402490 0.036925618 0.0133984801 -0.003731079 1.205508e-02# Covariance of asset returns
covariance_matrix <- cov(asset_returns_wide_tbl)
covariance_matrix## AGG EEM EFA IJS SPY
## AGG 7.398437e-05 0.0001042130 0.0000417845 -7.811737e-05 -9.028743e-06
## EEM 1.042130e-04 0.0017547107 0.0010390166 6.437728e-04 6.795425e-04
## EFA 4.178450e-05 0.0010390166 0.0010642377 6.490299e-04 6.975410e-04
## IJS -7.811737e-05 0.0006437728 0.0006490299 1.565449e-03 8.290243e-04
## SPY -9.028743e-06 0.0006795425 0.0006975410 8.290243e-04 7.408305e-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.02347493# 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.0003874334 0.009257143 0.005815634 0.005684466 0.00233025rowSums(component_contribution)## [1] 0.02347493# 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.0062311904 -0.002935713 0.0366063094 0.052133319 4.992316e-02
## 2013-02-28 0.0058908646 -0.023105234 -0.0129695678 0.016175235 1.267805e-02
## 2013-03-28 0.0009849123 -0.010234881 0.0129695678 0.040258095 3.726818e-02
## 2013-04-30 0.0096391968 0.012084893 0.0489675280 0.001222641 1.903022e-02
## 2013-05-31 -0.0202138929 -0.049483761 -0.0306555009 0.041976291 2.333548e-02
## 2013-06-28 -0.0157787243 -0.054727904 -0.0271447168 -0.001403001 -1.343454e-02
## 2013-07-31 0.0026886907 0.013159477 0.0518604052 0.063541427 5.038559e-02
## 2013-08-30 -0.0082984709 -0.025705577 -0.0197460608 -0.034743670 -3.045099e-02
## 2013-09-30 0.0111435398 0.069588954 0.0753383432 0.063873814 3.115546e-02
## 2013-10-31 0.0082920963 0.040861232 0.0320815778 0.034233907 4.526684e-02
## 2013-11-29 -0.0025096201 -0.002594076 0.0054497641 0.041661087 2.920721e-02
## 2013-12-31 -0.0055834346 -0.004074591 0.0215280092 0.012892381 2.559585e-02
## 2014-01-31 0.0152917893 -0.090322548 -0.0534133570 -0.035775652 -3.588445e-02
## 2014-02-28 0.0037568433 0.033220424 0.0595050922 0.045257525 4.451025e-02
## 2014-03-31 -0.0014814593 0.038022304 -0.0046024936 0.013315395 8.261300e-03
## 2014-04-30 0.0081827825 0.007772314 0.0165295008 -0.023184110 6.927160e-03
## 2014-05-30 0.0117222219 0.029091192 0.0158284424 0.006205367 2.294166e-02
## 2014-06-30 -0.0005752718 0.023733942 0.0091652618 0.037718965 2.043426e-02
## 2014-07-31 -0.0025127238 0.013555576 -0.0263798134 -0.052009399 -1.352832e-02
## 2014-08-29 0.0114304353 0.027904608 0.0018003983 0.043657452 3.870477e-02
## 2014-09-30 -0.0061670716 -0.080856897 -0.0395982980 -0.061260399 -1.389227e-02
## 2014-10-31 0.0105840841 0.014096575 -0.0026548515 0.068874727 2.327752e-02
## 2014-11-28 0.0065493629 -0.015541327 0.0006253294 0.004773887 2.710150e-02
## 2014-12-31 0.0014752498 -0.040442123 -0.0407468963 0.025295676 -2.539736e-03
## 2015-01-30 0.0203147147 -0.006895513 0.0062265361 -0.054627724 -3.007747e-02
## 2015-02-27 -0.0089884866 0.043135963 0.0614506677 0.056914215 5.468242e-02
## 2015-03-31 0.0037406260 -0.015086123 -0.0143889544 0.010156543 -1.583023e-02
## 2015-04-30 -0.0032325023 0.066281292 0.0358167407 -0.018417803 9.785785e-03
## 2015-05-29 -0.0043840856 -0.041911272 0.0019527114 0.007509863 1.277416e-02
## 2015-06-30 -0.0108255093 -0.029746532 -0.0316789202 0.004171665 -2.052141e-02
## 2015-07-31 0.0085849619 -0.065177705 0.0201144955 -0.027375578 2.233828e-02
## 2015-08-31 -0.0033641537 -0.092512654 -0.0771525048 -0.047268519 -6.288698e-02
## 2015-09-30 0.0080814394 -0.031824886 -0.0451946717 -0.038464678 -2.584679e-02
## 2015-10-30 0.0006858202 0.061808343 0.0640258172 0.063590096 8.163513e-02
## 2015-11-30 -0.0038981663 -0.025560542 -0.0075558116 0.024414955 3.647900e-03
## 2015-12-31 -0.0019189923 -0.038947210 -0.0235950500 -0.052156928 -1.743350e-02
## 2016-01-29 0.0123295610 -0.051636550 -0.0567578778 -0.060306811 -5.106851e-02
## 2016-02-29 0.0088315891 -0.008211537 -0.0339140194 0.020605043 -8.265217e-04
## 2016-03-31 0.0087093157 0.121879019 0.0637458506 0.089910313 6.510043e-02
## 2016-04-29 0.0025456702 0.004079241 0.0219748433 0.021044553 3.933342e-03
## 2016-05-31 0.0001355991 -0.037628459 -0.0008557389 0.004397027 1.686834e-02
## 2016-06-30 0.0191671556 0.044582283 -0.0244916117 0.008292246 3.469931e-03
## 2016-07-29 0.0054293316 0.052442034 0.0390001532 0.049347920 3.582192e-02
## 2016-08-31 -0.0021564407 0.008798599 0.0053269298 0.011261562 1.196811e-03
## 2016-09-30 0.0005168282 0.024873105 0.0132791624 0.008614664 5.810719e-05
## 2016-10-31 -0.0082056256 -0.008312200 -0.0224037498 -0.038135029 -1.748914e-02
## 2016-11-30 -0.0259898860 -0.045162140 -0.0179746619 0.125246733 3.617624e-02
## 2016-12-30 0.0025382372 -0.002529523 0.0267032468 0.031491672 2.006898e-02
## 2017-01-31 0.0021262165 0.064431150 0.0323818240 -0.012144019 1.773664e-02
## 2017-02-28 0.0064376013 0.017257654 0.0118362680 0.013428646 3.853903e-02
## 2017-03-31 -0.0005528600 0.036189155 0.0318055161 -0.006532871 1.249196e-03
## 2017-04-28 0.0090292571 0.016866523 0.0239526422 0.005107452 9.877155e-03
## 2017-05-31 0.0068471818 0.028059785 0.0348099164 -0.022862425 1.401449e-02
## 2017-06-30 -0.0001822132 0.009223661 0.0029560003 0.029151954 6.354649e-03
## 2017-07-31 0.0033344043 0.056594326 0.0261878819 0.007481218 2.034594e-02
## 2017-08-31 0.0093688942 0.023244130 -0.0004482871 -0.027564273 2.913216e-03
## 2017-09-29 -0.0057324398 -0.000446055 0.0233429537 0.082321483 1.994921e-02
## 2017-10-31 0.0009780896 0.032278392 0.0166534419 0.005915982 2.329088e-02
## 2017-11-30 -0.0014836230 -0.003897316 0.0068700315 0.036913152 3.010775e-02
## 2017-12-29 0.0047402490 0.036925618 0.0133984801 -0.003731079 1.205508e-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 on 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()
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
plot_data <- asset_returns_wide_tbl %>%
calculate_component_contribution(w = c(.25, .25, .2, .2, .1)) %>%
# Transform 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 = 0.5)) +
labs(title = "Percent Contribution to Portfolio Volatility")
plot_data <- asset_returns_wide_tbl %>%
calculate_component_contribution(w = c(.25, .25, .2, .2, .1)) %>%
# Transform 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 = 0.5)) +
theme_tq() +
labs(title = "Percent Contribution to Portfolio Volatility and Weight", y = "Percent",
x = NULL)