Week 14: Code along 12
CHAPTER 10 Component Contribution to Standard Deviation
Chris Burpeau
2022-11-29
# 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.0062307001 -0.0029355326 0.0366062975 0.052133090 4.992331e-02
## 2013-02-28 0.0058912763 -0.0231053592 -0.0129694807 0.016175296 1.267823e-02
## 2013-03-28 0.0009845155 -0.0102348971 0.0129694807 0.040258214 3.726746e-02
## 2013-04-30 0.0096394150 0.0120845672 0.0489678726 0.001222426 1.903039e-02
## 2013-05-31 -0.0202139267 -0.0494834524 -0.0306555355 0.041976891 2.333517e-02
## 2013-06-28 -0.0157782639 -0.0547280627 -0.0271448189 -0.001403441 -1.343410e-02
## 2013-07-31 0.0026874595 0.0131595772 0.0518606009 0.063541239 5.038564e-02
## 2013-08-30 -0.0082982324 -0.0257054830 -0.0197463018 -0.034743517 -3.045096e-02
## 2013-09-30 0.0111445289 0.0695889549 0.0753384386 0.063873903 3.115580e-02
## 2013-10-31 0.0082916856 0.0408610426 0.0320817229 0.034233899 4.526659e-02
## 2013-11-29 -0.0025102459 -0.0025939546 0.0054496584 0.041661156 2.920713e-02
## 2013-12-31 -0.0055826405 -0.0040741613 0.0215280225 0.012892141 2.559576e-02
## 2014-01-31 0.0152914880 -0.0903227668 -0.0534132614 -0.035775400 -3.588460e-02
## 2014-02-28 0.0037574613 0.0332206897 0.0595051336 0.045257375 4.451059e-02
## 2014-03-31 -0.0014820228 0.0380214150 -0.0046027117 0.013315607 8.261467e-03
## 2014-04-30 0.0081833963 0.0077727387 0.0165295148 -0.023184410 6.927314e-03
## 2014-05-30 0.0117211251 0.0290912296 0.0158283984 0.006205385 2.294137e-02
## 2014-06-30 -0.0005754422 0.0237339392 0.0091652397 0.037718709 2.043452e-02
## 2014-07-31 -0.0025118114 0.0135557339 -0.0263797524 -0.052009494 -1.352867e-02
## 2014-08-29 0.0114304768 0.0279045096 0.0018003563 0.043658013 3.870493e-02
## 2014-09-30 -0.0061673477 -0.0808569185 -0.0395984072 -0.061260685 -1.389256e-02
## 2014-10-31 0.0105843415 0.0140965382 -0.0026547278 0.068874781 2.327807e-02
## 2014-11-28 0.0065489919 -0.0155412589 0.0006253064 0.004773654 2.710127e-02
## 2014-12-31 0.0014749456 -0.0404420637 -0.0407466023 0.025296207 -2.539901e-03
## 2015-01-30 0.0203152887 -0.0068957006 0.0062262004 -0.054628166 -3.007667e-02
## 2015-02-27 -0.0089882709 0.0431359224 0.0614505951 0.056914367 5.468157e-02
## 2015-03-31 0.0037403810 -0.0150860192 -0.0143886923 0.010156557 -1.583044e-02
## 2015-04-30 -0.0032331331 0.0662812840 0.0358165199 -0.018417602 9.785895e-03
## 2015-05-29 -0.0043835905 -0.0419109449 0.0019529192 0.007509861 1.277440e-02
## 2015-06-30 -0.0108255920 -0.0297464631 -0.0316789191 0.004171341 -2.052115e-02
## 2015-07-31 0.0085848896 -0.0651783273 0.0201145575 -0.027375561 2.233785e-02
## 2015-08-31 -0.0033639173 -0.0925122736 -0.0771525868 -0.047268207 -6.288666e-02
## 2015-09-30 0.0080815129 -0.0318250152 -0.0451949070 -0.038464863 -2.584744e-02
## 2015-10-30 0.0006854461 0.0618083092 0.0640259316 0.063589835 8.163513e-02
## 2015-11-30 -0.0038979960 -0.0255602814 -0.0075558433 0.024415267 3.648466e-03
## 2015-12-31 -0.0019193098 -0.0389473779 -0.0235949546 -0.052156823 -1.743346e-02
## 2016-01-29 0.0123302787 -0.0516366466 -0.0567577582 -0.060306815 -5.106888e-02
## 2016-02-29 0.0088315634 -0.0082114300 -0.0339140089 0.020605088 -8.263091e-04
## 2016-03-31 0.0087084213 0.1218788614 0.0637458087 0.089910386 6.510051e-02
## 2016-04-29 0.0025464082 0.0040795998 0.0219747881 0.021044173 3.933127e-03
## 2016-05-31 0.0001356009 -0.0376286757 -0.0008559819 0.004397040 1.686862e-02
## 2016-06-30 0.0191666741 0.0445822412 -0.0244915351 0.008292218 3.469756e-03
## 2016-07-29 0.0054295979 0.0524421462 0.0390004821 0.049348376 3.582203e-02
## 2016-08-31 -0.0021559916 0.0087985274 0.0053266413 0.011261071 1.196533e-03
## 2016-09-30 0.0005156102 0.0248729131 0.0132790223 0.008614804 5.843314e-05
## 2016-10-31 -0.0082050708 -0.0083121444 -0.0224037093 -0.038135103 -1.748909e-02
## 2016-11-30 -0.0259897292 -0.0451619591 -0.0179743580 0.125246660 3.617583e-02
## 2016-12-30 0.0025382061 -0.0025300066 0.0267028708 0.031491736 2.006935e-02
## 2017-01-31 0.0021261874 0.0644314025 0.0323820023 -0.012143938 1.773630e-02
## 2017-02-28 0.0064380303 0.0172579347 0.0118364448 0.013428395 3.853916e-02
## 2017-03-31 -0.0005530505 0.0361889302 0.0318056796 -0.006532626 1.249459e-03
## 2017-04-28 0.0090293317 0.0168664931 0.0239521542 0.005107985 9.877012e-03
## 2017-05-31 0.0068471467 0.0280598590 0.0348102159 -0.022862824 1.401434e-02
## 2017-06-30 -0.0001825434 0.0092238919 0.0029559199 0.029151640 6.354647e-03
## 2017-07-31 0.0033343269 0.0565943473 0.0261878558 0.007481570 2.034578e-02
## 2017-08-31 0.0093692282 0.0232439220 -0.0004482984 -0.027564421 2.913531e-03
## 2017-09-29 -0.0057323056 -0.0004462966 0.0233427917 0.082321455 1.994909e-02
## 2017-10-31 0.0009779681 0.0322785406 0.0166536426 0.005916213 2.329079e-02
## 2017-11-30 -0.0014840982 -0.0038968393 0.0068700936 0.036913076 3.010793e-02
## 2017-12-29 0.0047403459 0.0369251832 0.0133984000 -0.003731134 1.205490e-02# Covariance of asset returns
covariance_matrix <- cov(asset_returns_wide_tbl)
covariance_matrix## AGG EEM EFA IJS SPY
## AGG 7.398380e-05 0.0001042087 4.178324e-05 -0.0000781209 -9.031428e-06
## EEM 1.042087e-04 0.0017547091 1.039016e-03 0.0006437743 6.795435e-04
## EFA 4.178324e-05 0.0010390164 1.064239e-03 0.0006490303 6.975426e-04
## IJS -7.812090e-05 0.0006437743 6.490303e-04 0.0015654514 8.290246e-04
## SPY -9.031428e-06 0.0006795435 6.975426e-04 0.0008290246 7.408288e-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.0003874077 0.009257139 0.005815639 0.005684471 0.002330251rowSums(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")
asset_returns_wide_tbl ## AGG EEM EFA IJS SPY
## 2013-01-31 -0.0062307001 -0.0029355326 0.0366062975 0.052133090 4.992331e-02
## 2013-02-28 0.0058912763 -0.0231053592 -0.0129694807 0.016175296 1.267823e-02
## 2013-03-28 0.0009845155 -0.0102348971 0.0129694807 0.040258214 3.726746e-02
## 2013-04-30 0.0096394150 0.0120845672 0.0489678726 0.001222426 1.903039e-02
## 2013-05-31 -0.0202139267 -0.0494834524 -0.0306555355 0.041976891 2.333517e-02
## 2013-06-28 -0.0157782639 -0.0547280627 -0.0271448189 -0.001403441 -1.343410e-02
## 2013-07-31 0.0026874595 0.0131595772 0.0518606009 0.063541239 5.038564e-02
## 2013-08-30 -0.0082982324 -0.0257054830 -0.0197463018 -0.034743517 -3.045096e-02
## 2013-09-30 0.0111445289 0.0695889549 0.0753384386 0.063873903 3.115580e-02
## 2013-10-31 0.0082916856 0.0408610426 0.0320817229 0.034233899 4.526659e-02
## 2013-11-29 -0.0025102459 -0.0025939546 0.0054496584 0.041661156 2.920713e-02
## 2013-12-31 -0.0055826405 -0.0040741613 0.0215280225 0.012892141 2.559576e-02
## 2014-01-31 0.0152914880 -0.0903227668 -0.0534132614 -0.035775400 -3.588460e-02
## 2014-02-28 0.0037574613 0.0332206897 0.0595051336 0.045257375 4.451059e-02
## 2014-03-31 -0.0014820228 0.0380214150 -0.0046027117 0.013315607 8.261467e-03
## 2014-04-30 0.0081833963 0.0077727387 0.0165295148 -0.023184410 6.927314e-03
## 2014-05-30 0.0117211251 0.0290912296 0.0158283984 0.006205385 2.294137e-02
## 2014-06-30 -0.0005754422 0.0237339392 0.0091652397 0.037718709 2.043452e-02
## 2014-07-31 -0.0025118114 0.0135557339 -0.0263797524 -0.052009494 -1.352867e-02
## 2014-08-29 0.0114304768 0.0279045096 0.0018003563 0.043658013 3.870493e-02
## 2014-09-30 -0.0061673477 -0.0808569185 -0.0395984072 -0.061260685 -1.389256e-02
## 2014-10-31 0.0105843415 0.0140965382 -0.0026547278 0.068874781 2.327807e-02
## 2014-11-28 0.0065489919 -0.0155412589 0.0006253064 0.004773654 2.710127e-02
## 2014-12-31 0.0014749456 -0.0404420637 -0.0407466023 0.025296207 -2.539901e-03
## 2015-01-30 0.0203152887 -0.0068957006 0.0062262004 -0.054628166 -3.007667e-02
## 2015-02-27 -0.0089882709 0.0431359224 0.0614505951 0.056914367 5.468157e-02
## 2015-03-31 0.0037403810 -0.0150860192 -0.0143886923 0.010156557 -1.583044e-02
## 2015-04-30 -0.0032331331 0.0662812840 0.0358165199 -0.018417602 9.785895e-03
## 2015-05-29 -0.0043835905 -0.0419109449 0.0019529192 0.007509861 1.277440e-02
## 2015-06-30 -0.0108255920 -0.0297464631 -0.0316789191 0.004171341 -2.052115e-02
## 2015-07-31 0.0085848896 -0.0651783273 0.0201145575 -0.027375561 2.233785e-02
## 2015-08-31 -0.0033639173 -0.0925122736 -0.0771525868 -0.047268207 -6.288666e-02
## 2015-09-30 0.0080815129 -0.0318250152 -0.0451949070 -0.038464863 -2.584744e-02
## 2015-10-30 0.0006854461 0.0618083092 0.0640259316 0.063589835 8.163513e-02
## 2015-11-30 -0.0038979960 -0.0255602814 -0.0075558433 0.024415267 3.648466e-03
## 2015-12-31 -0.0019193098 -0.0389473779 -0.0235949546 -0.052156823 -1.743346e-02
## 2016-01-29 0.0123302787 -0.0516366466 -0.0567577582 -0.060306815 -5.106888e-02
## 2016-02-29 0.0088315634 -0.0082114300 -0.0339140089 0.020605088 -8.263091e-04
## 2016-03-31 0.0087084213 0.1218788614 0.0637458087 0.089910386 6.510051e-02
## 2016-04-29 0.0025464082 0.0040795998 0.0219747881 0.021044173 3.933127e-03
## 2016-05-31 0.0001356009 -0.0376286757 -0.0008559819 0.004397040 1.686862e-02
## 2016-06-30 0.0191666741 0.0445822412 -0.0244915351 0.008292218 3.469756e-03
## 2016-07-29 0.0054295979 0.0524421462 0.0390004821 0.049348376 3.582203e-02
## 2016-08-31 -0.0021559916 0.0087985274 0.0053266413 0.011261071 1.196533e-03
## 2016-09-30 0.0005156102 0.0248729131 0.0132790223 0.008614804 5.843314e-05
## 2016-10-31 -0.0082050708 -0.0083121444 -0.0224037093 -0.038135103 -1.748909e-02
## 2016-11-30 -0.0259897292 -0.0451619591 -0.0179743580 0.125246660 3.617583e-02
## 2016-12-30 0.0025382061 -0.0025300066 0.0267028708 0.031491736 2.006935e-02
## 2017-01-31 0.0021261874 0.0644314025 0.0323820023 -0.012143938 1.773630e-02
## 2017-02-28 0.0064380303 0.0172579347 0.0118364448 0.013428395 3.853916e-02
## 2017-03-31 -0.0005530505 0.0361889302 0.0318056796 -0.006532626 1.249459e-03
## 2017-04-28 0.0090293317 0.0168664931 0.0239521542 0.005107985 9.877012e-03
## 2017-05-31 0.0068471467 0.0280598590 0.0348102159 -0.022862824 1.401434e-02
## 2017-06-30 -0.0001825434 0.0092238919 0.0029559199 0.029151640 6.354647e-03
## 2017-07-31 0.0033343269 0.0565943473 0.0261878558 0.007481570 2.034578e-02
## 2017-08-31 0.0093692282 0.0232439220 -0.0004482984 -0.027564421 2.913531e-03
## 2017-09-29 -0.0057323056 -0.0004462966 0.0233427917 0.082321455 1.994909e-02
## 2017-10-31 0.0009779681 0.0322785406 0.0166536426 0.005916213 2.329079e-02
## 2017-11-30 -0.0014840982 -0.0038968393 0.0068700936 0.036913076 3.010793e-02
## 2017-12-29 0.0047403459 0.0369251832 0.0133984000 -0.003731134 1.205490e-02 calculate_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
pivot_longer(col = everything(), names_to = "Asset", values_to = "Contribution")
plot_data %>%
ggplot() +
scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
theme(plot.title = element_text(hjust = .5))
labs(title = "percent contribution to the portfolio volatility")## $title
## [1] "percent contribution to the portfolio volatility"
##
## attr(,"class")
## [1] "labels"Column Chart of Component Contribution and weight ## 6 Rolling Component Contribution
plot_data <- asset_returns_wide_tbl %>% calculate_component_contribution(w = c(.25,.25,.2,.2,.1)) %>%
#transform to long
pivot_longer(cols = everything(), names_to = "Asset", values_to = "Contribution") %>%
#add weight
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() +
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 the portfolio volatility and weight", y = "percent", x = NULL)