Week 14: Code along 12
CHAPTER 10 Component Contribution to Standard Deviation
Damian Senesac
2022-11-28
# 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.0062317481 -0.0029353117 0.0366062715 0.052133096 4.992313e-02
## 2013-02-28 0.0058919724 -0.0231051562 -0.0129695485 0.016175806 1.267793e-02
## 2013-03-28 0.0009844246 -0.0102352068 0.0129695485 0.040257813 3.726793e-02
## 2013-04-30 0.0096395940 0.0120845659 0.0489678048 0.001222503 1.903028e-02
## 2013-05-31 -0.0202143572 -0.0494834467 -0.0306555355 0.041976347 2.333528e-02
## 2013-06-28 -0.0157781851 -0.0547281186 -0.0271445454 -0.001403072 -1.343443e-02
## 2013-07-31 0.0026877270 0.0131596382 0.0518602626 0.063541522 5.038597e-02
## 2013-08-30 -0.0082980435 -0.0257054798 -0.0197463914 -0.034743702 -3.045107e-02
## 2013-09-30 0.0111441657 0.0695889464 0.0753385931 0.063873993 3.115548e-02
## 2013-10-31 0.0082919500 0.0408609243 0.0320817229 0.034234048 4.526722e-02
## 2013-11-29 -0.0025098074 -0.0025942676 0.0054496584 0.041661230 2.920662e-02
## 2013-12-31 -0.0055835171 -0.0040739625 0.0215281769 0.012891747 2.559625e-02
## 2014-01-31 0.0152916618 -0.0903226525 -0.0534134158 -0.035775233 -3.588469e-02
## 2014-02-28 0.0037573704 0.0332205687 0.0595049802 0.045257351 4.451030e-02
## 2014-03-31 -0.0014817611 0.0380216234 -0.0046024812 0.013315486 8.261468e-03
## 2014-04-30 0.0081827965 0.0077727669 0.0165294377 -0.023184514 6.927407e-03
## 2014-05-30 0.0117223129 0.0290912263 0.0158284730 0.006205631 2.294137e-02
## 2014-06-30 -0.0005766253 0.0237338269 0.0091653683 0.037718687 2.043479e-02
## 2014-07-31 -0.0025116445 0.0135555176 -0.0263799557 -0.052009470 -1.352895e-02
## 2014-08-29 0.0114307342 0.0279048311 0.0018005836 0.043657712 3.870449e-02
## 2014-09-30 -0.0061676929 -0.0808569096 -0.0395985557 -0.061260298 -1.389221e-02
## 2014-10-31 0.0105848519 0.0140966491 -0.0026549646 0.068874691 2.327781e-02
## 2014-11-28 0.0065491660 -0.0155413696 0.0006254644 0.004773732 2.710170e-02
## 2014-12-31 0.0014747702 -0.0404420590 -0.0407466846 0.025295688 -2.540074e-03
## 2015-01-30 0.0203147070 -0.0068956998 0.0062265075 -0.054627803 -3.007720e-02
## 2015-02-27 -0.0089876911 0.0431359174 0.0614503702 0.056914729 5.468202e-02
## 2015-03-31 0.0037404665 -0.0150859301 -0.0143885558 0.010156328 -1.583011e-02
## 2015-04-30 -0.0032333807 0.0662809713 0.0358165339 -0.018417791 9.785723e-03
## 2015-05-29 -0.0043832542 -0.0419107223 0.0019525622 0.007509842 1.277457e-02
## 2015-06-30 -0.0108255115 -0.0297468109 -0.0316786351 0.004171342 -2.052132e-02
## 2015-07-31 0.0085839727 -0.0651782181 0.0201144040 -0.027375329 2.233752e-02
## 2015-08-31 -0.0033630899 -0.0925121487 -0.0771524288 -0.047268363 -6.288659e-02
## 2015-09-30 0.0080810990 -0.0318251567 -0.0451950749 -0.038464693 -2.584691e-02
## 2015-10-30 0.0006855327 0.0618081847 0.0640259369 0.063589825 8.163494e-02
## 2015-11-30 -0.0038984085 -0.0255602201 -0.0075558439 0.024415321 3.648303e-03
## 2015-12-31 -0.0019188212 -0.0389470313 -0.0235948734 -0.052157345 -1.743354e-02
## 2016-01-29 0.0123299555 -0.0516367138 -0.0567578461 -0.060306769 -5.106862e-02
## 2016-02-29 0.0088315655 -0.0082114294 -0.0339140802 0.020605008 -8.265715e-04
## 2016-03-31 0.0087084234 0.1218788527 0.0637459679 0.089910513 6.510044e-02
## 2016-04-29 0.0025469774 0.0040791679 0.0219748716 0.021044330 3.933291e-03
## 2016-05-31 0.0001352008 -0.0376285173 -0.0008559818 0.004396888 1.686887e-02
## 2016-06-30 0.0191665929 0.0445824481 -0.0244915330 0.008292427 3.469755e-03
## 2016-07-29 0.0054295987 0.0524422088 0.0390001700 0.049348519 3.582179e-02
## 2016-08-31 -0.0021561463 0.0087987130 0.0053269498 0.011260927 1.196846e-03
## 2016-09-30 0.0005163924 0.0248725440 0.0132790819 0.008614751 5.796025e-05
## 2016-10-31 -0.0082056997 -0.0083121454 -0.0224036234 -0.038134850 -1.748893e-02
## 2016-11-30 -0.0259894990 -0.0451618371 -0.0179745854 0.125246347 3.617599e-02
## 2016-12-30 0.0025379616 -0.0025299426 0.0267028708 0.031491849 2.006905e-02
## 2017-01-31 0.0021263574 0.0644314586 0.0323820023 -0.012143764 1.773659e-02
## 2017-02-28 0.0064378723 0.0172580506 0.0118363664 0.013428814 3.853930e-02
## 2017-03-31 -0.0005530611 0.0361888080 0.0318056821 -0.006533046 1.249170e-03
## 2017-04-28 0.0090292601 0.0168662675 0.0239523044 0.005107703 9.877156e-03
## 2017-05-31 0.0068474595 0.0280600796 0.0348101417 -0.022862411 1.401413e-02
## 2017-06-30 -0.0001826990 0.0092236754 0.0029559913 0.029151569 6.354788e-03
## 2017-07-31 0.0033340894 0.0565945569 0.0261877148 0.007481461 2.034591e-02
## 2017-08-31 0.0093693950 0.0232437207 -0.0004480896 -0.027564908 2.913265e-03
## 2017-09-29 -0.0057319975 -0.0004460229 0.0233426525 0.082321936 1.994922e-02
## 2017-10-31 0.0009781223 0.0322783665 0.0166537763 0.005915878 2.329079e-02
## 2017-11-30 -0.0014838504 -0.0038970086 0.0068698270 0.036913503 3.010781e-02
## 2017-12-29 0.0047399433 0.0369253525 0.0133985820 -0.003731344 1.205502e-02# Covariance of asset returns
covariance_matrix <- cov(asset_returns_wide_tbl)
covariance_matrix## AGG EEM EFA IJS SPY
## AGG 7.398399e-05 0.0001042098 4.178262e-05 -7.811863e-05 -9.032054e-06
## EEM 1.042098e-04 0.0017547071 1.039017e-03 6.437749e-04 6.795426e-04
## EFA 4.178262e-05 0.0010390169 1.064238e-03 6.490305e-04 6.975411e-04
## IJS -7.811863e-05 0.0006437749 6.490305e-04 1.565451e-03 8.290251e-04
## SPY -9.032054e-06 0.0006795426 6.975411e-04 8.290251e-04 7.408294e-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.000387414 0.009257136 0.005815636 0.005684477 0.002330249rowSums(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.0062317481 -0.0029353117 0.0366062715 0.052133096 4.992313e-02
## 2013-02-28 0.0058919724 -0.0231051562 -0.0129695485 0.016175806 1.267793e-02
## 2013-03-28 0.0009844246 -0.0102352068 0.0129695485 0.040257813 3.726793e-02
## 2013-04-30 0.0096395940 0.0120845659 0.0489678048 0.001222503 1.903028e-02
## 2013-05-31 -0.0202143572 -0.0494834467 -0.0306555355 0.041976347 2.333528e-02
## 2013-06-28 -0.0157781851 -0.0547281186 -0.0271445454 -0.001403072 -1.343443e-02
## 2013-07-31 0.0026877270 0.0131596382 0.0518602626 0.063541522 5.038597e-02
## 2013-08-30 -0.0082980435 -0.0257054798 -0.0197463914 -0.034743702 -3.045107e-02
## 2013-09-30 0.0111441657 0.0695889464 0.0753385931 0.063873993 3.115548e-02
## 2013-10-31 0.0082919500 0.0408609243 0.0320817229 0.034234048 4.526722e-02
## 2013-11-29 -0.0025098074 -0.0025942676 0.0054496584 0.041661230 2.920662e-02
## 2013-12-31 -0.0055835171 -0.0040739625 0.0215281769 0.012891747 2.559625e-02
## 2014-01-31 0.0152916618 -0.0903226525 -0.0534134158 -0.035775233 -3.588469e-02
## 2014-02-28 0.0037573704 0.0332205687 0.0595049802 0.045257351 4.451030e-02
## 2014-03-31 -0.0014817611 0.0380216234 -0.0046024812 0.013315486 8.261468e-03
## 2014-04-30 0.0081827965 0.0077727669 0.0165294377 -0.023184514 6.927407e-03
## 2014-05-30 0.0117223129 0.0290912263 0.0158284730 0.006205631 2.294137e-02
## 2014-06-30 -0.0005766253 0.0237338269 0.0091653683 0.037718687 2.043479e-02
## 2014-07-31 -0.0025116445 0.0135555176 -0.0263799557 -0.052009470 -1.352895e-02
## 2014-08-29 0.0114307342 0.0279048311 0.0018005836 0.043657712 3.870449e-02
## 2014-09-30 -0.0061676929 -0.0808569096 -0.0395985557 -0.061260298 -1.389221e-02
## 2014-10-31 0.0105848519 0.0140966491 -0.0026549646 0.068874691 2.327781e-02
## 2014-11-28 0.0065491660 -0.0155413696 0.0006254644 0.004773732 2.710170e-02
## 2014-12-31 0.0014747702 -0.0404420590 -0.0407466846 0.025295688 -2.540074e-03
## 2015-01-30 0.0203147070 -0.0068956998 0.0062265075 -0.054627803 -3.007720e-02
## 2015-02-27 -0.0089876911 0.0431359174 0.0614503702 0.056914729 5.468202e-02
## 2015-03-31 0.0037404665 -0.0150859301 -0.0143885558 0.010156328 -1.583011e-02
## 2015-04-30 -0.0032333807 0.0662809713 0.0358165339 -0.018417791 9.785723e-03
## 2015-05-29 -0.0043832542 -0.0419107223 0.0019525622 0.007509842 1.277457e-02
## 2015-06-30 -0.0108255115 -0.0297468109 -0.0316786351 0.004171342 -2.052132e-02
## 2015-07-31 0.0085839727 -0.0651782181 0.0201144040 -0.027375329 2.233752e-02
## 2015-08-31 -0.0033630899 -0.0925121487 -0.0771524288 -0.047268363 -6.288659e-02
## 2015-09-30 0.0080810990 -0.0318251567 -0.0451950749 -0.038464693 -2.584691e-02
## 2015-10-30 0.0006855327 0.0618081847 0.0640259369 0.063589825 8.163494e-02
## 2015-11-30 -0.0038984085 -0.0255602201 -0.0075558439 0.024415321 3.648303e-03
## 2015-12-31 -0.0019188212 -0.0389470313 -0.0235948734 -0.052157345 -1.743354e-02
## 2016-01-29 0.0123299555 -0.0516367138 -0.0567578461 -0.060306769 -5.106862e-02
## 2016-02-29 0.0088315655 -0.0082114294 -0.0339140802 0.020605008 -8.265715e-04
## 2016-03-31 0.0087084234 0.1218788527 0.0637459679 0.089910513 6.510044e-02
## 2016-04-29 0.0025469774 0.0040791679 0.0219748716 0.021044330 3.933291e-03
## 2016-05-31 0.0001352008 -0.0376285173 -0.0008559818 0.004396888 1.686887e-02
## 2016-06-30 0.0191665929 0.0445824481 -0.0244915330 0.008292427 3.469755e-03
## 2016-07-29 0.0054295987 0.0524422088 0.0390001700 0.049348519 3.582179e-02
## 2016-08-31 -0.0021561463 0.0087987130 0.0053269498 0.011260927 1.196846e-03
## 2016-09-30 0.0005163924 0.0248725440 0.0132790819 0.008614751 5.796025e-05
## 2016-10-31 -0.0082056997 -0.0083121454 -0.0224036234 -0.038134850 -1.748893e-02
## 2016-11-30 -0.0259894990 -0.0451618371 -0.0179745854 0.125246347 3.617599e-02
## 2016-12-30 0.0025379616 -0.0025299426 0.0267028708 0.031491849 2.006905e-02
## 2017-01-31 0.0021263574 0.0644314586 0.0323820023 -0.012143764 1.773659e-02
## 2017-02-28 0.0064378723 0.0172580506 0.0118363664 0.013428814 3.853930e-02
## 2017-03-31 -0.0005530611 0.0361888080 0.0318056821 -0.006533046 1.249170e-03
## 2017-04-28 0.0090292601 0.0168662675 0.0239523044 0.005107703 9.877156e-03
## 2017-05-31 0.0068474595 0.0280600796 0.0348101417 -0.022862411 1.401413e-02
## 2017-06-30 -0.0001826990 0.0092236754 0.0029559913 0.029151569 6.354788e-03
## 2017-07-31 0.0033340894 0.0565945569 0.0261877148 0.007481461 2.034591e-02
## 2017-08-31 0.0093693950 0.0232437207 -0.0004480896 -0.027564908 2.913265e-03
## 2017-09-29 -0.0057319975 -0.0004460229 0.0233426525 0.082321936 1.994922e-02
## 2017-10-31 0.0009781223 0.0322783665 0.0166537763 0.005915878 2.329079e-02
## 2017-11-30 -0.0014838504 -0.0038970086 0.0068698270 0.036913503 3.010781e-02
## 2017-12-29 0.0047399433 0.0369253525 0.0133985820 -0.003731344 1.205502e-02calculate_component_contribution <- function(.data, w) {
# Covariance of asset returns
covariance_matrix <- cov(asset_returns_wide_tbl)
# 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 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")
Column Chart of Component Contribution and Weight
plot_data_with_weight <- 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 Data
pivot_longer(cols = c(Contribution, weight), names_to = "type", values_to = "value")
plot_data_with_weight %>%
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)