Week 14: Code along 12
CHAPTER 10 Component Contribution to Standard Deviation
Spencer Murrin
2023-04-25
# 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.0062315191 -0.0029355123 0.0366062437 0.052133385 4.992309e-02
## 2013-02-28 0.0058916902 -0.0231054002 -0.0129692994 0.016175479 1.267801e-02
## 2013-03-28 0.0009844323 -0.0102348823 0.0129692994 0.040258161 3.726831e-02
## 2013-04-30 0.0096391417 0.0120848827 0.0489679512 0.001222373 1.902997e-02
## 2013-05-31 -0.0202143648 -0.0494835384 -0.0306557184 0.041976617 2.333518e-02
## 2013-06-28 -0.0157774535 -0.0547283841 -0.0271446607 -0.001403488 -1.343455e-02
## 2013-07-31 0.0026871834 0.0131597489 0.0518604624 0.063541785 5.038625e-02
## 2013-08-30 -0.0082977817 -0.0257056191 -0.0197462315 -0.034743456 -3.045089e-02
## 2013-09-30 0.0111439130 0.0695886389 0.0753384342 0.063873701 3.115561e-02
## 2013-10-31 0.0082917447 0.0408614901 0.0320817073 0.034234064 4.526677e-02
## 2013-11-29 -0.0025091676 -0.0025941888 0.0054495396 0.041661036 2.920665e-02
## 2013-12-31 -0.0055827229 -0.0040742138 0.0215281500 0.012892206 2.559601e-02
## 2014-01-31 0.0152912613 -0.0903228334 -0.0534131976 -0.035775546 -3.588434e-02
## 2014-02-28 0.0037563130 0.0332206525 0.0595048157 0.045257346 4.451011e-02
## 2014-03-31 -0.0014815839 0.0380215361 -0.0046026225 0.013315865 8.261307e-03
## 2014-04-30 0.0081835572 0.0077727682 0.0165296507 -0.023184848 6.927852e-03
## 2014-05-30 0.0117212892 0.0290914227 0.0158282194 0.006205611 2.294098e-02
## 2014-06-30 -0.0005755533 0.0237339251 0.0091654908 0.037718662 2.043464e-02
## 2014-07-31 -0.0025119009 0.0135556828 -0.0263797850 -0.052009312 -1.352878e-02
## 2014-08-29 0.0114306778 0.0279042759 0.0018003039 0.043657580 3.870482e-02
## 2014-09-30 -0.0061675009 -0.0808564754 -0.0395984639 -0.061260305 -1.389245e-02
## 2014-10-31 0.0105844305 0.0140964530 -0.0026547335 0.068874767 2.327815e-02
## 2014-11-28 0.0065489290 -0.0155414364 0.0006253941 0.004773703 2.710121e-02
## 2014-12-31 0.0014752891 -0.0404419772 -0.0407467494 0.025295977 -2.539598e-03
## 2015-01-30 0.0203150123 -0.0068961123 0.0062265031 -0.054628216 -3.007711e-02
## 2015-02-27 -0.0089884249 0.0431362951 0.0614505257 0.056914815 5.468177e-02
## 2015-03-31 0.0037401669 -0.0150859161 -0.0143886138 0.010156264 -1.583022e-02
## 2015-04-30 -0.0032329065 0.0662811397 0.0358167037 -0.018417618 9.785727e-03
## 2015-05-29 -0.0043834159 -0.0419107844 0.0019523330 0.007509817 1.277442e-02
## 2015-06-30 -0.0108256315 -0.0297468921 -0.0316786710 0.004171319 -2.052159e-02
## 2015-07-31 0.0085846366 -0.0651779566 0.0201143765 -0.027375318 2.233840e-02
## 2015-08-31 -0.0033636943 -0.0925123461 -0.0771524393 -0.047268229 -6.288702e-02
## 2015-09-30 0.0080815113 -0.0318252165 -0.0451950417 -0.038464927 -2.584711e-02
## 2015-10-30 0.0006853392 0.0618085509 0.0640260403 0.063589835 8.163487e-02
## 2015-11-30 -0.0038983764 -0.0255606696 -0.0075557185 0.024415250 3.648761e-03
## 2015-12-31 -0.0019189101 -0.0389468704 -0.0235950539 -0.052157113 -1.743371e-02
## 2016-01-29 0.0123300518 -0.0516368295 -0.0567579647 -0.060306770 -5.106889e-02
## 2016-02-29 0.0088316840 -0.0082116151 -0.0339139173 0.020605195 -8.258222e-04
## 2016-03-31 0.0087088859 0.1218790855 0.0637457685 0.089910389 6.509999e-02
## 2016-04-29 0.0025457891 0.0040794249 0.0219750380 0.021044114 3.933282e-03
## 2016-05-31 0.0001359322 -0.0376285945 -0.0008559750 0.004397040 1.686839e-02
## 2016-06-30 0.0191668923 0.0445823277 -0.0244913860 0.008292458 3.470137e-03
## 2016-07-29 0.0054293775 0.0524421804 0.0390000275 0.049348298 3.582195e-02
## 2016-08-31 -0.0021565141 0.0087984416 0.0053270066 0.011261086 1.196641e-03
## 2016-09-30 0.0005164073 0.0248729397 0.0132789414 0.008614676 5.813243e-05
## 2016-10-31 -0.0082053340 -0.0083122303 -0.0224037272 -0.038135055 -1.748918e-02
## 2016-11-30 -0.0259899782 -0.0451618177 -0.0179743651 0.125246519 3.617619e-02
## 2016-12-30 0.0025381136 -0.0025301568 0.0267030340 0.031492046 2.006893e-02
## 2017-01-31 0.0021262880 0.0644313657 0.0323817147 -0.012144033 1.773673e-02
## 2017-02-28 0.0064377603 0.0172582547 0.0118366182 0.013428343 3.853910e-02
## 2017-03-31 -0.0005527220 0.0361886441 0.0318055175 -0.006532599 1.249064e-03
## 2017-04-28 0.0090292876 0.0168664006 0.0239522359 0.005107693 9.877395e-03
## 2017-05-31 0.0068478122 0.0280599941 0.0348102715 -0.022862738 1.401419e-02
## 2017-06-30 -0.0001833856 0.0092238050 0.0029558685 0.029151896 6.354713e-03
## 2017-07-31 0.0033346307 0.0565945969 0.0261878997 0.007481729 2.034586e-02
## 2017-08-31 0.0093692990 0.0232437818 -0.0004483665 -0.027564737 2.913399e-03
## 2017-09-29 -0.0057320437 -0.0004460776 0.0233429111 0.082321612 1.994918e-02
## 2017-10-31 0.0009777310 0.0322785054 0.0166535214 0.005915987 2.329059e-02
## 2017-11-30 -0.0014838193 -0.0038971467 0.0068702540 0.036913295 3.010830e-02
## 2017-12-29 0.0047397448 0.0369254109 0.0133981683 -0.003731318 1.205465e-02# Covariance of asset returns
covariance_matrix <- cov(asset_returns_wide_tbl)
covariance_matrix## AGG EEM EFA IJS SPY
## AGG 7.398357e-05 0.0001042087 4.178072e-05 -7.812312e-05 -9.032881e-06
## EEM 1.042087e-04 0.0017547109 1.039018e-03 6.437752e-04 6.795432e-04
## EFA 4.178072e-05 0.0010390178 1.064237e-03 6.490309e-04 6.975404e-04
## IJS -7.812312e-05 0.0006437752 6.490309e-04 1.565453e-03 8.290265e-04
## SPY -9.032881e-06 0.0006795432 6.975404e-04 8.290265e-04 7.408295e-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.0234749# 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.0003873955 0.00925715 0.005815635 0.005684474 0.00233025rowSums(component_contribution)## [1] 0.0234749# 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.0062315191 -0.0029355123 0.0366062437 0.052133385 4.992309e-02
## 2013-02-28 0.0058916902 -0.0231054002 -0.0129692994 0.016175479 1.267801e-02
## 2013-03-28 0.0009844323 -0.0102348823 0.0129692994 0.040258161 3.726831e-02
## 2013-04-30 0.0096391417 0.0120848827 0.0489679512 0.001222373 1.902997e-02
## 2013-05-31 -0.0202143648 -0.0494835384 -0.0306557184 0.041976617 2.333518e-02
## 2013-06-28 -0.0157774535 -0.0547283841 -0.0271446607 -0.001403488 -1.343455e-02
## 2013-07-31 0.0026871834 0.0131597489 0.0518604624 0.063541785 5.038625e-02
## 2013-08-30 -0.0082977817 -0.0257056191 -0.0197462315 -0.034743456 -3.045089e-02
## 2013-09-30 0.0111439130 0.0695886389 0.0753384342 0.063873701 3.115561e-02
## 2013-10-31 0.0082917447 0.0408614901 0.0320817073 0.034234064 4.526677e-02
## 2013-11-29 -0.0025091676 -0.0025941888 0.0054495396 0.041661036 2.920665e-02
## 2013-12-31 -0.0055827229 -0.0040742138 0.0215281500 0.012892206 2.559601e-02
## 2014-01-31 0.0152912613 -0.0903228334 -0.0534131976 -0.035775546 -3.588434e-02
## 2014-02-28 0.0037563130 0.0332206525 0.0595048157 0.045257346 4.451011e-02
## 2014-03-31 -0.0014815839 0.0380215361 -0.0046026225 0.013315865 8.261307e-03
## 2014-04-30 0.0081835572 0.0077727682 0.0165296507 -0.023184848 6.927852e-03
## 2014-05-30 0.0117212892 0.0290914227 0.0158282194 0.006205611 2.294098e-02
## 2014-06-30 -0.0005755533 0.0237339251 0.0091654908 0.037718662 2.043464e-02
## 2014-07-31 -0.0025119009 0.0135556828 -0.0263797850 -0.052009312 -1.352878e-02
## 2014-08-29 0.0114306778 0.0279042759 0.0018003039 0.043657580 3.870482e-02
## 2014-09-30 -0.0061675009 -0.0808564754 -0.0395984639 -0.061260305 -1.389245e-02
## 2014-10-31 0.0105844305 0.0140964530 -0.0026547335 0.068874767 2.327815e-02
## 2014-11-28 0.0065489290 -0.0155414364 0.0006253941 0.004773703 2.710121e-02
## 2014-12-31 0.0014752891 -0.0404419772 -0.0407467494 0.025295977 -2.539598e-03
## 2015-01-30 0.0203150123 -0.0068961123 0.0062265031 -0.054628216 -3.007711e-02
## 2015-02-27 -0.0089884249 0.0431362951 0.0614505257 0.056914815 5.468177e-02
## 2015-03-31 0.0037401669 -0.0150859161 -0.0143886138 0.010156264 -1.583022e-02
## 2015-04-30 -0.0032329065 0.0662811397 0.0358167037 -0.018417618 9.785727e-03
## 2015-05-29 -0.0043834159 -0.0419107844 0.0019523330 0.007509817 1.277442e-02
## 2015-06-30 -0.0108256315 -0.0297468921 -0.0316786710 0.004171319 -2.052159e-02
## 2015-07-31 0.0085846366 -0.0651779566 0.0201143765 -0.027375318 2.233840e-02
## 2015-08-31 -0.0033636943 -0.0925123461 -0.0771524393 -0.047268229 -6.288702e-02
## 2015-09-30 0.0080815113 -0.0318252165 -0.0451950417 -0.038464927 -2.584711e-02
## 2015-10-30 0.0006853392 0.0618085509 0.0640260403 0.063589835 8.163487e-02
## 2015-11-30 -0.0038983764 -0.0255606696 -0.0075557185 0.024415250 3.648761e-03
## 2015-12-31 -0.0019189101 -0.0389468704 -0.0235950539 -0.052157113 -1.743371e-02
## 2016-01-29 0.0123300518 -0.0516368295 -0.0567579647 -0.060306770 -5.106889e-02
## 2016-02-29 0.0088316840 -0.0082116151 -0.0339139173 0.020605195 -8.258222e-04
## 2016-03-31 0.0087088859 0.1218790855 0.0637457685 0.089910389 6.509999e-02
## 2016-04-29 0.0025457891 0.0040794249 0.0219750380 0.021044114 3.933282e-03
## 2016-05-31 0.0001359322 -0.0376285945 -0.0008559750 0.004397040 1.686839e-02
## 2016-06-30 0.0191668923 0.0445823277 -0.0244913860 0.008292458 3.470137e-03
## 2016-07-29 0.0054293775 0.0524421804 0.0390000275 0.049348298 3.582195e-02
## 2016-08-31 -0.0021565141 0.0087984416 0.0053270066 0.011261086 1.196641e-03
## 2016-09-30 0.0005164073 0.0248729397 0.0132789414 0.008614676 5.813243e-05
## 2016-10-31 -0.0082053340 -0.0083122303 -0.0224037272 -0.038135055 -1.748918e-02
## 2016-11-30 -0.0259899782 -0.0451618177 -0.0179743651 0.125246519 3.617619e-02
## 2016-12-30 0.0025381136 -0.0025301568 0.0267030340 0.031492046 2.006893e-02
## 2017-01-31 0.0021262880 0.0644313657 0.0323817147 -0.012144033 1.773673e-02
## 2017-02-28 0.0064377603 0.0172582547 0.0118366182 0.013428343 3.853910e-02
## 2017-03-31 -0.0005527220 0.0361886441 0.0318055175 -0.006532599 1.249064e-03
## 2017-04-28 0.0090292876 0.0168664006 0.0239522359 0.005107693 9.877395e-03
## 2017-05-31 0.0068478122 0.0280599941 0.0348102715 -0.022862738 1.401419e-02
## 2017-06-30 -0.0001833856 0.0092238050 0.0029558685 0.029151896 6.354713e-03
## 2017-07-31 0.0033346307 0.0565945969 0.0261878997 0.007481729 2.034586e-02
## 2017-08-31 0.0093692990 0.0232437818 -0.0004483665 -0.027564737 2.913399e-03
## 2017-09-29 -0.0057320437 -0.0004460776 0.0233429111 0.082321612 1.994918e-02
## 2017-10-31 0.0009777310 0.0322785054 0.0166535214 0.005915987 2.329059e-02
## 2017-11-30 -0.0014838193 -0.0038971467 0.0068702540 0.036913295 3.010830e-02
## 2017-12-29 0.0047397448 0.0369254109 0.0133981683 -0.003731318 1.205465e-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()
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)) %>%
# 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 Volatility")
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 Volatility and Weight", y = "Percent",
x = NULL)