Week 14: Code along 12
CHAPTER 10 Component Contribution to Standard Deviation
Matthew White
2023-11-27
# 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.0062312735 -0.0029353763 0.0366065391 0.052133049 4.992337e-02
## 2013-02-28 0.0058907812 -0.0231055176 -0.0129694909 0.016175220 1.267788e-02
## 2013-03-28 0.0009854119 -0.0102349254 0.0129694909 0.040258353 3.726848e-02
## 2013-04-30 0.0096391593 0.0120847586 0.0489675653 0.001222415 1.903006e-02
## 2013-05-31 -0.0202134933 -0.0494834727 -0.0306554910 0.041976528 2.333494e-02
## 2013-06-28 -0.0157788157 -0.0547281830 -0.0271443834 -0.001402985 -1.343417e-02
## 2013-07-31 0.0026876436 0.0131596671 0.0518602788 0.063541191 5.038606e-02
## 2013-08-30 -0.0082982009 -0.0257054565 -0.0197464131 -0.034743351 -3.045128e-02
## 2013-09-30 0.0111438611 0.0695886777 0.0753386770 0.063873735 3.115566e-02
## 2013-10-31 0.0082924297 0.0408611570 0.0320816681 0.034234128 4.526648e-02
## 2013-11-29 -0.0025098862 -0.0025938766 0.0054496043 0.041661092 2.920734e-02
## 2013-12-31 -0.0055828015 -0.0040747246 0.0215278748 0.012892093 2.559607e-02
## 2014-01-31 0.0152912566 -0.0903222937 -0.0534130865 -0.035775366 -3.588472e-02
## 2014-02-28 0.0037564620 0.0332205063 0.0595048209 0.045257593 4.451045e-02
## 2014-03-31 -0.0014813479 0.0380215122 -0.0046024341 0.013315169 8.261378e-03
## 2014-04-30 0.0081831575 0.0077729821 0.0165293020 -0.023184190 6.927395e-03
## 2014-05-30 0.0117221889 0.0290910772 0.0158287428 0.006205175 2.294163e-02
## 2014-06-30 -0.0005760663 0.0237337591 0.0091651609 0.037718818 2.043398e-02
## 2014-07-31 -0.0025119898 0.0135559112 -0.0263798044 -0.052009490 -1.352847e-02
## 2014-08-29 0.0114305404 0.0279043981 0.0018004841 0.043657941 3.870483e-02
## 2014-09-30 -0.0061672476 -0.0808565497 -0.0395984640 -0.061260360 -1.389240e-02
## 2014-10-31 0.0105848216 0.0140964715 -0.0026547526 0.068874579 2.327776e-02
## 2014-11-28 0.0065487321 -0.0155414192 0.0006253047 0.004773810 2.710157e-02
## 2014-12-31 0.0014749044 -0.0404421914 -0.0407468108 0.025296152 -2.539968e-03
## 2015-01-30 0.0203152625 -0.0068955068 0.0062265285 -0.054627936 -3.007685e-02
## 2015-02-27 -0.0089887403 0.0431359184 0.0614505640 0.056914160 5.468184e-02
## 2015-03-31 0.0037407952 -0.0150863480 -0.0143887049 0.010156715 -1.583047e-02
## 2015-04-30 -0.0032332190 0.0662816421 0.0358165244 -0.018417983 9.786266e-03
## 2015-05-29 -0.0043838757 -0.0419110934 0.0019528496 0.007509799 1.277413e-02
## 2015-06-30 -0.0108257937 -0.0297467198 -0.0316788122 0.004171549 -2.052125e-02
## 2015-07-31 0.0085856074 -0.0651779413 0.0201144482 -0.027375561 2.233777e-02
## 2015-08-31 -0.0033640090 -0.0925122874 -0.0771525733 -0.047268521 -6.288673e-02
## 2015-09-30 0.0080814781 -0.0318251679 -0.0451947566 -0.038464443 -2.584712e-02
## 2015-10-30 0.0006853730 0.0618083383 0.0640256953 0.063589762 8.163506e-02
## 2015-11-30 -0.0038988043 -0.0255604791 -0.0075557112 0.024415234 3.648189e-03
## 2015-12-31 -0.0019186143 -0.0389470315 -0.0235952734 -0.052156971 -1.743325e-02
## 2016-01-29 0.0123297409 -0.0516368651 -0.0567578185 -0.060307020 -5.106900e-02
## 2016-02-29 0.0088315931 -0.0082114400 -0.0339138230 0.020605318 -8.261215e-04
## 2016-03-31 0.0087089249 0.1218790760 0.0637458677 0.089910366 6.510028e-02
## 2016-04-29 0.0025462471 0.0040792259 0.0219749858 0.021044190 3.933665e-03
## 2016-05-31 0.0001357085 -0.0376285571 -0.0008560276 0.004397177 1.686812e-02
## 2016-06-30 0.0191667009 0.0445823534 -0.0244915750 0.008292207 3.469884e-03
## 2016-07-29 0.0054293851 0.0524423020 0.0390001722 0.049348568 3.582176e-02
## 2016-08-31 -0.0021560021 0.0087983415 0.0053269936 0.011260866 1.197111e-03
## 2016-09-30 0.0005163619 0.0248729273 0.0132790411 0.008614676 5.783828e-05
## 2016-10-31 -0.0082058736 -0.0083119022 -0.0224036697 -0.038134756 -1.748868e-02
## 2016-11-30 -0.0259892951 -0.0451619084 -0.0179745375 0.125246602 3.617576e-02
## 2016-12-30 0.0025377652 -0.0025303202 0.0267029082 0.031491450 2.006893e-02
## 2017-01-31 0.0021263934 0.0644315990 0.0323819073 -0.012143607 1.773681e-02
## 2017-02-28 0.0064378615 0.0172579629 0.0118366069 0.013428500 3.853926e-02
## 2017-03-31 -0.0005528840 0.0361887280 0.0318055250 -0.006532869 1.248711e-03
## 2017-04-28 0.0090289695 0.0168666612 0.0239523250 0.005107842 9.877422e-03
## 2017-05-31 0.0068472512 0.0280597349 0.0348102548 -0.022862536 1.401435e-02
## 2017-06-30 -0.0001822202 0.0092237253 0.0029559201 0.029151516 6.354760e-03
## 2017-07-31 0.0033342728 0.0565945276 0.0261877950 0.007481576 2.034581e-02
## 2017-08-31 0.0093691804 0.0232439074 -0.0004482411 -0.027564995 2.913450e-03
## 2017-09-29 -0.0057324614 -0.0004464664 0.0233427009 0.082322097 1.994902e-02
## 2017-10-31 0.0009782064 0.0322788034 0.0166536351 0.005916019 2.329065e-02
## 2017-11-30 -0.0014838855 -0.0038970433 0.0068700624 0.036913166 3.010819e-02
## 2017-12-29 0.0047401547 0.0369252818 0.0133982941 -0.003731369 1.205500e-02# Covariance of asset returns
covariance_matrix <- cov(asset_returns_wide_tbl)
covariance_matrix## AGG EEM EFA IJS SPY
## AGG 7.398413e-05 0.0001042099 4.178279e-05 -7.811976e-05 -9.030138e-06
## EEM 1.042099e-04 0.0017547093 1.039016e-03 6.437704e-04 6.795438e-04
## EFA 4.178279e-05 0.0010390159 1.064236e-03 6.490291e-04 6.975415e-04
## IJS -7.811976e-05 0.0006437704 6.490291e-04 1.565450e-03 8.290231e-04
## SPY -9.030138e-06 0.0006795438 6.975415e-04 8.290231e-04 7.408297e-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.0003874148 0.009257137 0.005815633 0.005684462 0.002330252rowSums(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.0062312735 -0.0029353763 0.0366065391 0.052133049 4.992337e-02
## 2013-02-28 0.0058907812 -0.0231055176 -0.0129694909 0.016175220 1.267788e-02
## 2013-03-28 0.0009854119 -0.0102349254 0.0129694909 0.040258353 3.726848e-02
## 2013-04-30 0.0096391593 0.0120847586 0.0489675653 0.001222415 1.903006e-02
## 2013-05-31 -0.0202134933 -0.0494834727 -0.0306554910 0.041976528 2.333494e-02
## 2013-06-28 -0.0157788157 -0.0547281830 -0.0271443834 -0.001402985 -1.343417e-02
## 2013-07-31 0.0026876436 0.0131596671 0.0518602788 0.063541191 5.038606e-02
## 2013-08-30 -0.0082982009 -0.0257054565 -0.0197464131 -0.034743351 -3.045128e-02
## 2013-09-30 0.0111438611 0.0695886777 0.0753386770 0.063873735 3.115566e-02
## 2013-10-31 0.0082924297 0.0408611570 0.0320816681 0.034234128 4.526648e-02
## 2013-11-29 -0.0025098862 -0.0025938766 0.0054496043 0.041661092 2.920734e-02
## 2013-12-31 -0.0055828015 -0.0040747246 0.0215278748 0.012892093 2.559607e-02
## 2014-01-31 0.0152912566 -0.0903222937 -0.0534130865 -0.035775366 -3.588472e-02
## 2014-02-28 0.0037564620 0.0332205063 0.0595048209 0.045257593 4.451045e-02
## 2014-03-31 -0.0014813479 0.0380215122 -0.0046024341 0.013315169 8.261378e-03
## 2014-04-30 0.0081831575 0.0077729821 0.0165293020 -0.023184190 6.927395e-03
## 2014-05-30 0.0117221889 0.0290910772 0.0158287428 0.006205175 2.294163e-02
## 2014-06-30 -0.0005760663 0.0237337591 0.0091651609 0.037718818 2.043398e-02
## 2014-07-31 -0.0025119898 0.0135559112 -0.0263798044 -0.052009490 -1.352847e-02
## 2014-08-29 0.0114305404 0.0279043981 0.0018004841 0.043657941 3.870483e-02
## 2014-09-30 -0.0061672476 -0.0808565497 -0.0395984640 -0.061260360 -1.389240e-02
## 2014-10-31 0.0105848216 0.0140964715 -0.0026547526 0.068874579 2.327776e-02
## 2014-11-28 0.0065487321 -0.0155414192 0.0006253047 0.004773810 2.710157e-02
## 2014-12-31 0.0014749044 -0.0404421914 -0.0407468108 0.025296152 -2.539968e-03
## 2015-01-30 0.0203152625 -0.0068955068 0.0062265285 -0.054627936 -3.007685e-02
## 2015-02-27 -0.0089887403 0.0431359184 0.0614505640 0.056914160 5.468184e-02
## 2015-03-31 0.0037407952 -0.0150863480 -0.0143887049 0.010156715 -1.583047e-02
## 2015-04-30 -0.0032332190 0.0662816421 0.0358165244 -0.018417983 9.786266e-03
## 2015-05-29 -0.0043838757 -0.0419110934 0.0019528496 0.007509799 1.277413e-02
## 2015-06-30 -0.0108257937 -0.0297467198 -0.0316788122 0.004171549 -2.052125e-02
## 2015-07-31 0.0085856074 -0.0651779413 0.0201144482 -0.027375561 2.233777e-02
## 2015-08-31 -0.0033640090 -0.0925122874 -0.0771525733 -0.047268521 -6.288673e-02
## 2015-09-30 0.0080814781 -0.0318251679 -0.0451947566 -0.038464443 -2.584712e-02
## 2015-10-30 0.0006853730 0.0618083383 0.0640256953 0.063589762 8.163506e-02
## 2015-11-30 -0.0038988043 -0.0255604791 -0.0075557112 0.024415234 3.648189e-03
## 2015-12-31 -0.0019186143 -0.0389470315 -0.0235952734 -0.052156971 -1.743325e-02
## 2016-01-29 0.0123297409 -0.0516368651 -0.0567578185 -0.060307020 -5.106900e-02
## 2016-02-29 0.0088315931 -0.0082114400 -0.0339138230 0.020605318 -8.261215e-04
## 2016-03-31 0.0087089249 0.1218790760 0.0637458677 0.089910366 6.510028e-02
## 2016-04-29 0.0025462471 0.0040792259 0.0219749858 0.021044190 3.933665e-03
## 2016-05-31 0.0001357085 -0.0376285571 -0.0008560276 0.004397177 1.686812e-02
## 2016-06-30 0.0191667009 0.0445823534 -0.0244915750 0.008292207 3.469884e-03
## 2016-07-29 0.0054293851 0.0524423020 0.0390001722 0.049348568 3.582176e-02
## 2016-08-31 -0.0021560021 0.0087983415 0.0053269936 0.011260866 1.197111e-03
## 2016-09-30 0.0005163619 0.0248729273 0.0132790411 0.008614676 5.783828e-05
## 2016-10-31 -0.0082058736 -0.0083119022 -0.0224036697 -0.038134756 -1.748868e-02
## 2016-11-30 -0.0259892951 -0.0451619084 -0.0179745375 0.125246602 3.617576e-02
## 2016-12-30 0.0025377652 -0.0025303202 0.0267029082 0.031491450 2.006893e-02
## 2017-01-31 0.0021263934 0.0644315990 0.0323819073 -0.012143607 1.773681e-02
## 2017-02-28 0.0064378615 0.0172579629 0.0118366069 0.013428500 3.853926e-02
## 2017-03-31 -0.0005528840 0.0361887280 0.0318055250 -0.006532869 1.248711e-03
## 2017-04-28 0.0090289695 0.0168666612 0.0239523250 0.005107842 9.877422e-03
## 2017-05-31 0.0068472512 0.0280597349 0.0348102548 -0.022862536 1.401435e-02
## 2017-06-30 -0.0001822202 0.0092237253 0.0029559201 0.029151516 6.354760e-03
## 2017-07-31 0.0033342728 0.0565945276 0.0261877950 0.007481576 2.034581e-02
## 2017-08-31 0.0093691804 0.0232439074 -0.0004482411 -0.027564995 2.913450e-03
## 2017-09-29 -0.0057324614 -0.0004464664 0.0233427009 0.082322097 1.994902e-02
## 2017-10-31 0.0009782064 0.0322788034 0.0166536351 0.005916019 2.329065e-02
## 2017-11-30 -0.0014838855 -0.0038970433 0.0068700624 0.036913166 3.010819e-02
## 2017-12-29 0.0047401547 0.0369252818 0.0133982941 -0.003731369 1.205500e-02cal_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 %>% cal_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 %>%
cal_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 %>%
cal_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)
## 6 Rolling Component Contribution