Week 14: Code along 12
CHAPTER 10 Component Contribution to Standard Deviation
Job Boonstoppel
2023-06-16
# 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.0062311986 -0.0029354841 0.0366065391 0.052133595 4.992336e-02
## 2013-02-28 0.0058913029 -0.0231052995 -0.0129694016 0.016174927 1.267771e-02
## 2013-03-28 0.0009847276 -0.0102352585 0.0129694016 0.040258332 3.726833e-02
## 2013-04-30 0.0096393989 0.0120849815 0.0489674814 0.001222311 1.903043e-02
## 2013-05-31 -0.0202136949 -0.0494832414 -0.0306553206 0.041976512 2.333552e-02
## 2013-06-28 -0.0157784052 -0.0547284143 -0.0271446476 -0.001402679 -1.343500e-02
## 2013-07-31 0.0026872316 0.0131596068 0.0518603722 0.063540726 5.038615e-02
## 2013-08-30 -0.0082978604 -0.0257055199 -0.0197463287 -0.034743016 -3.045123e-02
## 2013-09-30 0.0111437318 0.0695885706 0.0753386770 0.063873453 3.115617e-02
## 2013-10-31 0.0082919028 0.0408616094 0.0320815908 0.034234084 4.526677e-02
## 2013-11-29 -0.0025095335 -0.0025940982 0.0054496048 0.041661084 2.920676e-02
## 2013-12-31 -0.0055831080 -0.0040743900 0.0215281022 0.012892158 2.559601e-02
## 2014-01-31 0.0152908962 -0.0903225673 -0.0534132369 -0.035775310 -3.588433e-02
## 2014-02-28 0.0037573802 0.0332205633 0.0595049704 0.045257339 4.451020e-02
## 2014-03-31 -0.0014811509 0.0380216214 -0.0046025837 0.013315373 8.261306e-03
## 2014-04-30 0.0081834581 0.0077725291 0.0165293759 -0.023184317 6.927371e-03
## 2014-05-30 0.0117210359 0.0290913028 0.0158286689 0.006205400 2.294146e-02
## 2014-06-30 -0.0005756471 0.0237338661 0.0091653050 0.037718518 2.043463e-02
## 2014-07-31 -0.0025121196 0.0135556986 -0.0263798006 -0.052009198 -1.352878e-02
## 2014-08-29 0.0114308202 0.0279046064 0.0018003361 0.043657696 3.870445e-02
## 2014-09-30 -0.0061673394 -0.0808567637 -0.0395985408 -0.061260443 -1.389200e-02
## 2014-10-31 0.0105845535 0.0140964731 -0.0026548299 0.068875046 2.327789e-02
## 2014-11-28 0.0065488466 -0.0155413094 0.0006254588 0.004773450 2.710147e-02
## 2014-12-31 0.0014747047 -0.0404420753 -0.0407467306 0.025295838 -2.540111e-03
## 2015-01-30 0.0203156673 -0.0068958566 0.0062264483 -0.054627927 -3.007703e-02
## 2015-02-27 -0.0089884279 0.0431364879 0.0614505640 0.056914499 5.468203e-02
## 2015-03-31 0.0037402545 -0.0150864566 -0.0143888570 0.010156836 -1.583039e-02
## 2015-04-30 -0.0032333236 0.0662810958 0.0358168233 -0.018418025 9.785726e-03
## 2015-05-29 -0.0043832151 -0.0419106635 0.0019524099 0.007509766 1.277442e-02
## 2015-06-30 -0.0108257003 -0.0297469449 -0.0316786705 0.004171653 -2.052151e-02
## 2015-07-31 0.0085847614 -0.0651778881 0.0201144512 -0.027375563 2.233815e-02
## 2015-08-31 -0.0033636135 -0.0925124271 -0.0771525052 -0.047268508 -6.288650e-02
## 2015-09-30 0.0080813769 -0.0318248982 -0.0451947603 -0.038464406 -2.584729e-02
## 2015-10-30 0.0006853295 0.0618080746 0.0640258576 0.063589426 8.163496e-02
## 2015-11-30 -0.0038983529 -0.0255602844 -0.0075557898 0.024415199 3.648339e-03
## 2015-12-31 -0.0019185483 -0.0389471007 -0.0235949493 -0.052156702 -1.743346e-02
## 2016-01-29 0.0123296034 -0.0516366501 -0.0567578854 -0.060306851 -5.106880e-02
## 2016-02-29 0.0088316490 -0.0082115123 -0.0339139916 0.020605302 -8.260923e-04
## 2016-03-31 0.0087088620 0.1218789374 0.0637456126 0.089909958 6.510034e-02
## 2016-04-29 0.0025460767 0.0040792910 0.0219752337 0.021044433 3.933197e-03
## 2016-05-31 0.0001354073 -0.0376286244 -0.0008561090 0.004397110 1.686847e-02
## 2016-06-30 0.0191670939 0.0445825494 -0.0244915750 0.008292268 3.470050e-03
## 2016-07-29 0.0054296430 0.0524421733 0.0390004132 0.049348061 3.582171e-02
## 2016-08-31 -0.0021564796 0.0087982810 0.0053266728 0.011261350 1.197036e-03
## 2016-09-30 0.0005160979 0.0248727517 0.0132791210 0.008614872 5.781714e-05
## 2016-10-31 -0.0082053164 -0.0083117851 -0.0224036697 -0.038135007 -1.748877e-02
## 2016-11-30 -0.0259895705 -0.0451619762 -0.0179744554 0.125246430 3.617587e-02
## 2016-12-30 0.0025377613 -0.0025301334 0.0267029060 0.031491611 2.006901e-02
## 2017-01-31 0.0021265760 0.0644317161 0.0323819047 -0.012143923 1.773665e-02
## 2017-02-28 0.0064374794 0.0172577307 0.0118363001 0.013428972 3.853903e-02
## 2017-03-31 -0.0005529338 0.0361889541 0.0318056803 -0.006533303 1.249348e-03
## 2017-04-28 0.0090296015 0.0168663319 0.0239523991 0.005107972 9.877038e-03
## 2017-05-31 0.0068469869 0.0280602715 0.0348101151 -0.022862809 1.401426e-02
## 2017-06-30 -0.0001822261 0.0092235121 0.0029559902 0.029151952 6.354851e-03
## 2017-07-31 0.0033342094 0.0565944225 0.0261878647 0.007481453 2.034565e-02
## 2017-08-31 0.0093693547 0.0232440045 -0.0004482411 -0.027564468 2.913536e-03
## 2017-09-29 -0.0057324246 -0.0004463692 0.0233427009 0.082321611 1.994912e-02
## 2017-10-31 0.0009782661 0.0322784211 0.0166535047 0.005915868 2.329078e-02
## 2017-11-30 -0.0014842334 -0.0038969496 0.0068701928 0.036913453 3.010798e-02
## 2017-12-29 0.0047405078 0.0369253762 0.0133981663 -0.003731113 1.205496e-02# Covariance of asset returns
covariance_matrix <- cov(asset_returns_wide_tbl)
covariance_matrix## AGG EEM EFA IJS SPY
## AGG 7.398361e-05 0.0001042108 4.178219e-05 -7.812115e-05 -9.031426e-06
## EEM 1.042108e-04 0.0017547096 1.039017e-03 6.437691e-04 6.795431e-04
## EFA 4.178219e-05 0.0010390167 1.064237e-03 6.490269e-04 6.975417e-04
## IJS -7.812115e-05 0.0006437691 6.490269e-04 1.565445e-03 8.290218e-04
## SPY -9.031426e-06 0.0006795431 6.975417e-04 8.290218e-04 7.408298e-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.02347488# 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.0003874104 0.009257144 0.005815634 0.005684446 0.00233025rowSums(component_contribution)## [1] 0.02347488# 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.0062311986 -0.0029354841 0.0366065391 0.052133595 4.992336e-02
## 2013-02-28 0.0058913029 -0.0231052995 -0.0129694016 0.016174927 1.267771e-02
## 2013-03-28 0.0009847276 -0.0102352585 0.0129694016 0.040258332 3.726833e-02
## 2013-04-30 0.0096393989 0.0120849815 0.0489674814 0.001222311 1.903043e-02
## 2013-05-31 -0.0202136949 -0.0494832414 -0.0306553206 0.041976512 2.333552e-02
## 2013-06-28 -0.0157784052 -0.0547284143 -0.0271446476 -0.001402679 -1.343500e-02
## 2013-07-31 0.0026872316 0.0131596068 0.0518603722 0.063540726 5.038615e-02
## 2013-08-30 -0.0082978604 -0.0257055199 -0.0197463287 -0.034743016 -3.045123e-02
## 2013-09-30 0.0111437318 0.0695885706 0.0753386770 0.063873453 3.115617e-02
## 2013-10-31 0.0082919028 0.0408616094 0.0320815908 0.034234084 4.526677e-02
## 2013-11-29 -0.0025095335 -0.0025940982 0.0054496048 0.041661084 2.920676e-02
## 2013-12-31 -0.0055831080 -0.0040743900 0.0215281022 0.012892158 2.559601e-02
## 2014-01-31 0.0152908962 -0.0903225673 -0.0534132369 -0.035775310 -3.588433e-02
## 2014-02-28 0.0037573802 0.0332205633 0.0595049704 0.045257339 4.451020e-02
## 2014-03-31 -0.0014811509 0.0380216214 -0.0046025837 0.013315373 8.261306e-03
## 2014-04-30 0.0081834581 0.0077725291 0.0165293759 -0.023184317 6.927371e-03
## 2014-05-30 0.0117210359 0.0290913028 0.0158286689 0.006205400 2.294146e-02
## 2014-06-30 -0.0005756471 0.0237338661 0.0091653050 0.037718518 2.043463e-02
## 2014-07-31 -0.0025121196 0.0135556986 -0.0263798006 -0.052009198 -1.352878e-02
## 2014-08-29 0.0114308202 0.0279046064 0.0018003361 0.043657696 3.870445e-02
## 2014-09-30 -0.0061673394 -0.0808567637 -0.0395985408 -0.061260443 -1.389200e-02
## 2014-10-31 0.0105845535 0.0140964731 -0.0026548299 0.068875046 2.327789e-02
## 2014-11-28 0.0065488466 -0.0155413094 0.0006254588 0.004773450 2.710147e-02
## 2014-12-31 0.0014747047 -0.0404420753 -0.0407467306 0.025295838 -2.540111e-03
## 2015-01-30 0.0203156673 -0.0068958566 0.0062264483 -0.054627927 -3.007703e-02
## 2015-02-27 -0.0089884279 0.0431364879 0.0614505640 0.056914499 5.468203e-02
## 2015-03-31 0.0037402545 -0.0150864566 -0.0143888570 0.010156836 -1.583039e-02
## 2015-04-30 -0.0032333236 0.0662810958 0.0358168233 -0.018418025 9.785726e-03
## 2015-05-29 -0.0043832151 -0.0419106635 0.0019524099 0.007509766 1.277442e-02
## 2015-06-30 -0.0108257003 -0.0297469449 -0.0316786705 0.004171653 -2.052151e-02
## 2015-07-31 0.0085847614 -0.0651778881 0.0201144512 -0.027375563 2.233815e-02
## 2015-08-31 -0.0033636135 -0.0925124271 -0.0771525052 -0.047268508 -6.288650e-02
## 2015-09-30 0.0080813769 -0.0318248982 -0.0451947603 -0.038464406 -2.584729e-02
## 2015-10-30 0.0006853295 0.0618080746 0.0640258576 0.063589426 8.163496e-02
## 2015-11-30 -0.0038983529 -0.0255602844 -0.0075557898 0.024415199 3.648339e-03
## 2015-12-31 -0.0019185483 -0.0389471007 -0.0235949493 -0.052156702 -1.743346e-02
## 2016-01-29 0.0123296034 -0.0516366501 -0.0567578854 -0.060306851 -5.106880e-02
## 2016-02-29 0.0088316490 -0.0082115123 -0.0339139916 0.020605302 -8.260923e-04
## 2016-03-31 0.0087088620 0.1218789374 0.0637456126 0.089909958 6.510034e-02
## 2016-04-29 0.0025460767 0.0040792910 0.0219752337 0.021044433 3.933197e-03
## 2016-05-31 0.0001354073 -0.0376286244 -0.0008561090 0.004397110 1.686847e-02
## 2016-06-30 0.0191670939 0.0445825494 -0.0244915750 0.008292268 3.470050e-03
## 2016-07-29 0.0054296430 0.0524421733 0.0390004132 0.049348061 3.582171e-02
## 2016-08-31 -0.0021564796 0.0087982810 0.0053266728 0.011261350 1.197036e-03
## 2016-09-30 0.0005160979 0.0248727517 0.0132791210 0.008614872 5.781714e-05
## 2016-10-31 -0.0082053164 -0.0083117851 -0.0224036697 -0.038135007 -1.748877e-02
## 2016-11-30 -0.0259895705 -0.0451619762 -0.0179744554 0.125246430 3.617587e-02
## 2016-12-30 0.0025377613 -0.0025301334 0.0267029060 0.031491611 2.006901e-02
## 2017-01-31 0.0021265760 0.0644317161 0.0323819047 -0.012143923 1.773665e-02
## 2017-02-28 0.0064374794 0.0172577307 0.0118363001 0.013428972 3.853903e-02
## 2017-03-31 -0.0005529338 0.0361889541 0.0318056803 -0.006533303 1.249348e-03
## 2017-04-28 0.0090296015 0.0168663319 0.0239523991 0.005107972 9.877038e-03
## 2017-05-31 0.0068469869 0.0280602715 0.0348101151 -0.022862809 1.401426e-02
## 2017-06-30 -0.0001822261 0.0092235121 0.0029559902 0.029151952 6.354851e-03
## 2017-07-31 0.0033342094 0.0565944225 0.0261878647 0.007481453 2.034565e-02
## 2017-08-31 0.0093693547 0.0232440045 -0.0004482411 -0.027564468 2.913536e-03
## 2017-09-29 -0.0057324246 -0.0004463692 0.0233427009 0.082321611 1.994912e-02
## 2017-10-31 0.0009782661 0.0322784211 0.0166535047 0.005915868 2.329078e-02
## 2017-11-30 -0.0014842334 -0.0038969496 0.0068701928 0.036913453 3.010798e-02
## 2017-12-29 0.0047405078 0.0369253762 0.0133981663 -0.003731113 1.205496e-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 on 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 <- 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 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)