Week 14: Code along 12
CHAPTER 10 Component Contribution to Standard Deviation
Vincent Fosser
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.0062309780 -0.0029359391 0.0366064170 0.052133496 4.992333e-02
## 2013-02-28 0.0058910594 -0.0231051182 -0.0129690974 0.016175220 1.267800e-02
## 2013-03-28 0.0009848396 -0.0102348794 0.0129690974 0.040258225 3.726768e-02
## 2013-04-30 0.0096397122 0.0120847752 0.0489678087 0.001222520 1.903036e-02
## 2013-05-31 -0.0202144713 -0.0494837613 -0.0306556847 0.041976099 2.333538e-02
## 2013-06-28 -0.0157778893 -0.0547282900 -0.0271444386 -0.001402999 -1.343434e-02
## 2013-07-31 0.0026880528 0.0131598630 0.0518602211 0.063541691 5.038594e-02
## 2013-08-30 -0.0082982112 -0.0257057073 -0.0197461540 -0.034743739 -3.045152e-02
## 2013-09-30 0.0111440513 0.0695889632 0.0753385261 0.063874032 3.115639e-02
## 2013-10-31 0.0082917944 0.0408612364 0.0320815778 0.034233735 4.526623e-02
## 2013-11-29 -0.0025099692 -0.0025937251 0.0054498458 0.041661220 2.920658e-02
## 2013-12-31 -0.0055834047 -0.0040748251 0.0215280075 0.012892192 2.559609e-02
## 2014-01-31 0.0152918984 -0.0903225477 -0.0534134369 -0.035775347 -3.588433e-02
## 2014-02-28 0.0037568567 0.0332203617 0.0595051716 0.045257287 4.451079e-02
## 2014-03-31 -0.0014813266 0.0380220072 -0.0046025730 0.013315553 8.261360e-03
## 2014-04-30 0.0081829390 0.0077727917 0.0165293438 -0.023184595 6.927375e-03
## 2014-05-30 0.0117218559 0.0290910733 0.0158285221 0.006205789 2.294083e-02
## 2014-06-30 -0.0005758987 0.0237340549 0.0091651859 0.037718403 2.043492e-02
## 2014-07-31 -0.0025119498 0.0135553522 -0.0263796602 -0.052009354 -1.352860e-02
## 2014-08-29 0.0114306003 0.0279048269 0.0018005552 0.043657786 3.870472e-02
## 2014-09-30 -0.0061676342 -0.0808566531 -0.0395984549 -0.061260355 -1.389257e-02
## 2014-10-31 0.0105847103 0.0140962229 -0.0026548515 0.068874807 2.327796e-02
## 2014-11-28 0.0065485962 -0.0155409752 0.0006253294 0.004773526 2.710134e-02
## 2014-12-31 0.0014751205 -0.0404424750 -0.0407468111 0.025295843 -2.539638e-03
## 2015-01-30 0.0203152328 -0.0068955741 0.0062265356 -0.054627873 -3.007741e-02
## 2015-02-27 -0.0089881608 0.0431361421 0.0614505830 0.056914225 5.468211e-02
## 2015-03-31 0.0037406485 -0.0150863608 -0.0143888736 0.010156505 -1.583026e-02
## 2015-04-30 -0.0032331116 0.0662811877 0.0358168158 -0.018417222 9.785824e-03
## 2015-05-29 -0.0043835437 -0.0419108145 0.0019523999 0.007509750 1.277422e-02
## 2015-06-30 -0.0108256847 -0.0297466454 -0.0316786843 0.004171215 -2.052125e-02
## 2015-07-31 0.0085845377 -0.0651782106 0.0201145726 -0.027375185 2.233783e-02
## 2015-08-31 -0.0033636095 -0.0925122687 -0.0771526622 -0.047268673 -6.288657e-02
## 2015-09-30 0.0080813364 -0.0318248859 -0.0451946717 -0.038464588 -2.584731e-02
## 2015-10-30 0.0006852473 0.0618082745 0.0640258172 0.063589662 8.163486e-02
## 2015-11-30 -0.0038978987 -0.0255604733 -0.0075558116 0.024415376 3.648794e-03
## 2015-12-31 -0.0019193937 -0.0389472098 -0.0235952221 -0.052156847 -1.743370e-02
## 2016-01-29 0.0123301906 -0.0516366273 -0.0567577967 -0.060307123 -5.106863e-02
## 2016-02-29 0.0088317309 -0.0082115378 -0.0339139283 0.020605247 -8.260854e-04
## 2016-03-31 0.0087086873 0.1218791652 0.0637459390 0.089910558 6.510016e-02
## 2016-04-29 0.0025458689 0.0040789675 0.0219751008 0.021044120 3.933450e-03
## 2016-05-31 0.0001361215 -0.0376284665 -0.0008562580 0.004397090 1.686834e-02
## 2016-06-30 0.0191662834 0.0445824953 -0.0244914386 0.008292241 3.469995e-03
## 2016-07-29 0.0054297221 0.0524421628 0.0390001532 0.049348126 3.582189e-02
## 2016-08-31 -0.0021560140 0.0087982792 0.0053267601 0.011261306 1.196845e-03
## 2016-09-30 0.0005158236 0.0248733585 0.0132794996 0.008614703 5.770204e-05
## 2016-10-31 -0.0082049238 -0.0083121997 -0.0224039173 -0.038134943 -1.748905e-02
## 2016-11-30 -0.0259895998 -0.0451620062 -0.0179745747 0.125246429 3.617640e-02
## 2016-12-30 0.0025375818 -0.0025300489 0.0267030747 0.031491873 2.006900e-02
## 2017-01-31 0.0021262251 0.0644312942 0.0323817445 -0.012144378 1.773632e-02
## 2017-02-28 0.0064374617 0.0172579598 0.0118364324 0.013429115 3.853893e-02
## 2017-03-31 -0.0005523221 0.0361890338 0.0318058309 -0.006533117 1.249446e-03
## 2017-04-28 0.0090291777 0.0168661777 0.0239521738 0.005107677 9.877466e-03
## 2017-05-31 0.0068475925 0.0280599059 0.0348102184 -0.022862332 1.401410e-02
## 2017-06-30 -0.0001828897 0.0092241057 0.0029559999 0.029151837 6.354874e-03
## 2017-07-31 0.0033344468 0.0565945227 0.0261876618 0.007481292 2.034556e-02
## 2017-08-31 0.0093692730 0.0232437116 -0.0004482872 -0.027564901 2.913523e-03
## 2017-09-29 -0.0057327884 -0.0004461573 0.0233428145 0.082322086 1.994920e-02
## 2017-10-31 0.0009783606 0.0322782962 0.0166539996 0.005916055 2.329066e-02
## 2017-11-30 -0.0014841979 -0.0038970188 0.0068694787 0.036913208 3.010817e-02
## 2017-12-29 0.0047407582 0.0369255190 0.0133985507 -0.003731393 1.205499e-02# Covariance of asset returns
covariance_matrix <- cov(asset_returns_wide_tbl)
covariance_matrix## AGG EEM EFA IJS SPY
## AGG 7.398409e-05 0.0001042101 4.178254e-05 -7.812137e-05 -9.032865e-06
## EEM 1.042101e-04 0.0017547116 1.039018e-03 6.437740e-04 6.795425e-04
## EFA 4.178254e-05 0.0010390184 1.064239e-03 6.490306e-04 6.975410e-04
## IJS -7.812137e-05 0.0006437740 6.490306e-04 1.565452e-03 8.290282e-04
## SPY -9.032865e-06 0.0006795425 6.975410e-04 8.290282e-04 7.408292e-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.02347492# 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.0003874082 0.009257149 0.005815639 0.005684471 0.00233025rowSums(component_contribution)## [1] 0.02347492# 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.0062309780 -0.0029359391 0.0366064170 0.052133496 4.992333e-02
## 2013-02-28 0.0058910594 -0.0231051182 -0.0129690974 0.016175220 1.267800e-02
## 2013-03-28 0.0009848396 -0.0102348794 0.0129690974 0.040258225 3.726768e-02
## 2013-04-30 0.0096397122 0.0120847752 0.0489678087 0.001222520 1.903036e-02
## 2013-05-31 -0.0202144713 -0.0494837613 -0.0306556847 0.041976099 2.333538e-02
## 2013-06-28 -0.0157778893 -0.0547282900 -0.0271444386 -0.001402999 -1.343434e-02
## 2013-07-31 0.0026880528 0.0131598630 0.0518602211 0.063541691 5.038594e-02
## 2013-08-30 -0.0082982112 -0.0257057073 -0.0197461540 -0.034743739 -3.045152e-02
## 2013-09-30 0.0111440513 0.0695889632 0.0753385261 0.063874032 3.115639e-02
## 2013-10-31 0.0082917944 0.0408612364 0.0320815778 0.034233735 4.526623e-02
## 2013-11-29 -0.0025099692 -0.0025937251 0.0054498458 0.041661220 2.920658e-02
## 2013-12-31 -0.0055834047 -0.0040748251 0.0215280075 0.012892192 2.559609e-02
## 2014-01-31 0.0152918984 -0.0903225477 -0.0534134369 -0.035775347 -3.588433e-02
## 2014-02-28 0.0037568567 0.0332203617 0.0595051716 0.045257287 4.451079e-02
## 2014-03-31 -0.0014813266 0.0380220072 -0.0046025730 0.013315553 8.261360e-03
## 2014-04-30 0.0081829390 0.0077727917 0.0165293438 -0.023184595 6.927375e-03
## 2014-05-30 0.0117218559 0.0290910733 0.0158285221 0.006205789 2.294083e-02
## 2014-06-30 -0.0005758987 0.0237340549 0.0091651859 0.037718403 2.043492e-02
## 2014-07-31 -0.0025119498 0.0135553522 -0.0263796602 -0.052009354 -1.352860e-02
## 2014-08-29 0.0114306003 0.0279048269 0.0018005552 0.043657786 3.870472e-02
## 2014-09-30 -0.0061676342 -0.0808566531 -0.0395984549 -0.061260355 -1.389257e-02
## 2014-10-31 0.0105847103 0.0140962229 -0.0026548515 0.068874807 2.327796e-02
## 2014-11-28 0.0065485962 -0.0155409752 0.0006253294 0.004773526 2.710134e-02
## 2014-12-31 0.0014751205 -0.0404424750 -0.0407468111 0.025295843 -2.539638e-03
## 2015-01-30 0.0203152328 -0.0068955741 0.0062265356 -0.054627873 -3.007741e-02
## 2015-02-27 -0.0089881608 0.0431361421 0.0614505830 0.056914225 5.468211e-02
## 2015-03-31 0.0037406485 -0.0150863608 -0.0143888736 0.010156505 -1.583026e-02
## 2015-04-30 -0.0032331116 0.0662811877 0.0358168158 -0.018417222 9.785824e-03
## 2015-05-29 -0.0043835437 -0.0419108145 0.0019523999 0.007509750 1.277422e-02
## 2015-06-30 -0.0108256847 -0.0297466454 -0.0316786843 0.004171215 -2.052125e-02
## 2015-07-31 0.0085845377 -0.0651782106 0.0201145726 -0.027375185 2.233783e-02
## 2015-08-31 -0.0033636095 -0.0925122687 -0.0771526622 -0.047268673 -6.288657e-02
## 2015-09-30 0.0080813364 -0.0318248859 -0.0451946717 -0.038464588 -2.584731e-02
## 2015-10-30 0.0006852473 0.0618082745 0.0640258172 0.063589662 8.163486e-02
## 2015-11-30 -0.0038978987 -0.0255604733 -0.0075558116 0.024415376 3.648794e-03
## 2015-12-31 -0.0019193937 -0.0389472098 -0.0235952221 -0.052156847 -1.743370e-02
## 2016-01-29 0.0123301906 -0.0516366273 -0.0567577967 -0.060307123 -5.106863e-02
## 2016-02-29 0.0088317309 -0.0082115378 -0.0339139283 0.020605247 -8.260854e-04
## 2016-03-31 0.0087086873 0.1218791652 0.0637459390 0.089910558 6.510016e-02
## 2016-04-29 0.0025458689 0.0040789675 0.0219751008 0.021044120 3.933450e-03
## 2016-05-31 0.0001361215 -0.0376284665 -0.0008562580 0.004397090 1.686834e-02
## 2016-06-30 0.0191662834 0.0445824953 -0.0244914386 0.008292241 3.469995e-03
## 2016-07-29 0.0054297221 0.0524421628 0.0390001532 0.049348126 3.582189e-02
## 2016-08-31 -0.0021560140 0.0087982792 0.0053267601 0.011261306 1.196845e-03
## 2016-09-30 0.0005158236 0.0248733585 0.0132794996 0.008614703 5.770204e-05
## 2016-10-31 -0.0082049238 -0.0083121997 -0.0224039173 -0.038134943 -1.748905e-02
## 2016-11-30 -0.0259895998 -0.0451620062 -0.0179745747 0.125246429 3.617640e-02
## 2016-12-30 0.0025375818 -0.0025300489 0.0267030747 0.031491873 2.006900e-02
## 2017-01-31 0.0021262251 0.0644312942 0.0323817445 -0.012144378 1.773632e-02
## 2017-02-28 0.0064374617 0.0172579598 0.0118364324 0.013429115 3.853893e-02
## 2017-03-31 -0.0005523221 0.0361890338 0.0318058309 -0.006533117 1.249446e-03
## 2017-04-28 0.0090291777 0.0168661777 0.0239521738 0.005107677 9.877466e-03
## 2017-05-31 0.0068475925 0.0280599059 0.0348102184 -0.022862332 1.401410e-02
## 2017-06-30 -0.0001828897 0.0092241057 0.0029559999 0.029151837 6.354874e-03
## 2017-07-31 0.0033344468 0.0565945227 0.0261876618 0.007481292 2.034556e-02
## 2017-08-31 0.0093692730 0.0232437116 -0.0004482872 -0.027564901 2.913523e-03
## 2017-09-29 -0.0057327884 -0.0004461573 0.0233428145 0.082322086 1.994920e-02
## 2017-10-31 0.0009783606 0.0322782962 0.0166539996 0.005916055 2.329066e-02
## 2017-11-30 -0.0014841979 -0.0038970188 0.0068694787 0.036913208 3.010817e-02
## 2017-12-29 0.0047407582 0.0369255190 0.0133985507 -0.003731393 1.205499e-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
# 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, .20, .20, .10)) ## # 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)) %>%
# Transform to long from
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 Votality")
6 Rolling Component Contribution
Column Chart of Component Contribution and weight
plot_data <- asset_returns_wide_tbl %>%
calculate_component_contribution(w = c(.25, .25, .2, .2, .1)) %>%
# Transform to long from
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 Votality and Weight",
y = "Percent",
x = NULL)