Week 14: Code along 12
CHAPTER 10 Component Contribution to Standard Deviation
Casey Holmes
2023-12-05
# 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.0062310524 -0.0029352692 0.0366063564 0.052133154 4.992337e-02
## 2013-02-28 0.0058912134 -0.0231054098 -0.0129695801 0.016175426 1.267819e-02
## 2013-03-28 0.0009851343 -0.0102348139 0.0129695801 0.040258440 3.726775e-02
## 2013-04-30 0.0096386859 0.0120847573 0.0489678170 0.001222017 1.903006e-02
## 2013-05-31 -0.0202139164 -0.0494836985 -0.0306558292 0.041976433 2.333574e-02
## 2013-06-28 -0.0157783176 -0.0547282506 -0.0271445635 -0.001402890 -1.343439e-02
## 2013-07-31 0.0026876845 0.0131597901 0.0518603767 0.063541728 5.038550e-02
## 2013-08-30 -0.0082980656 -0.0257057055 -0.0197461583 -0.034743888 -3.045106e-02
## 2013-09-30 0.0111437973 0.0695887562 0.0753385111 0.063873735 3.115599e-02
## 2013-10-31 0.0082920612 0.0408614986 0.0320815933 0.034234128 4.526658e-02
## 2013-11-29 -0.0025093522 -0.0025938763 0.0054496052 0.041661011 2.920693e-02
## 2013-12-31 -0.0055833798 -0.0040745011 0.0215284048 0.012892173 2.559598e-02
## 2014-01-31 0.0152914611 -0.0903227504 -0.0534133833 -0.035775366 -3.588432e-02
## 2014-02-28 0.0037571041 0.0332206284 0.0595048163 0.045257435 4.451034e-02
## 2014-03-31 -0.0014817443 0.0380217395 -0.0046023586 0.013315483 8.261183e-03
## 2014-04-30 0.0081830919 0.0077727547 0.0165292256 -0.023184345 6.927299e-03
## 2014-05-30 0.0117216657 0.0290910772 0.0158285234 0.006205096 2.294126e-02
## 2014-06-30 -0.0005755729 0.0237337591 0.0091653784 0.037718821 2.043500e-02
## 2014-07-31 -0.0025124231 0.0135558056 -0.0263798025 -0.052009414 -1.352893e-02
## 2014-08-29 0.0114312053 0.0279047090 0.0018003362 0.043658018 3.870474e-02
## 2014-09-30 -0.0061672254 -0.0808568663 -0.0395981595 -0.061260437 -1.389213e-02
## 2014-10-31 0.0105842779 0.0140965828 -0.0026551373 0.068874655 2.327767e-02
## 2014-11-28 0.0065483279 -0.0155415306 0.0006253818 0.004773734 2.710148e-02
## 2014-12-31 0.0014760953 -0.0404419639 -0.0407468140 0.025296078 -2.539708e-03
## 2015-01-30 0.0203149361 -0.0068957397 0.0062265290 -0.054628018 -3.007729e-02
## 2015-02-27 -0.0089887149 0.0431361472 0.0614505688 0.056914316 5.468219e-02
## 2015-03-31 0.0037406598 -0.0150861191 -0.0143886299 0.010156569 -1.583039e-02
## 2015-04-30 -0.0032329931 0.0662815139 0.0358165978 -0.018417986 9.785922e-03
## 2015-05-29 -0.0043837538 -0.0419113061 0.0019527030 0.007510096 1.277362e-02
## 2015-06-30 -0.0108256616 -0.0297466055 -0.0316787390 0.004171254 -2.052083e-02
## 2015-07-31 0.0085847421 -0.0651780556 0.0201142260 -0.027375111 2.233803e-02
## 2015-08-31 -0.0033634851 -0.0925125549 -0.0771523511 -0.047268427 -6.288673e-02
## 2015-09-30 0.0080813224 -0.0318248313 -0.0451948403 -0.038464840 -2.584730e-02
## 2015-10-30 0.0006851102 0.0618083991 0.0640257790 0.063589994 8.163498e-02
## 2015-11-30 -0.0038981052 -0.0255606755 -0.0075557903 0.024414852 3.648443e-03
## 2015-12-31 -0.0019187850 -0.0389469649 -0.0235952752 -0.052156661 -1.743333e-02
## 2016-01-29 0.0123292979 -0.0516366464 -0.0567574803 -0.060307095 -5.106873e-02
## 2016-02-29 0.0088320617 -0.0082116587 -0.0339139916 0.020605316 -8.263021e-04
## 2016-03-31 0.0087087074 0.1218790760 0.0637456958 0.089910284 6.510019e-02
## 2016-04-29 0.0025465859 0.0040792259 0.0219749876 0.021044338 3.933327e-03
## 2016-05-31 0.0001355704 -0.0376284898 -0.0008559461 0.004396881 1.686871e-02
## 2016-06-30 0.0191663196 0.0445825435 -0.0244916585 0.008292501 3.469718e-03
## 2016-07-29 0.0054298813 0.0524417392 0.0390004967 0.049348213 3.582192e-02
## 2016-08-31 -0.0021566513 0.0087985863 0.0053267526 0.011261212 1.196872e-03
## 2016-09-30 0.0005162292 0.0248731059 0.0132791199 0.008614675 5.799761e-05
## 2016-10-31 -0.0082050351 -0.0083122584 -0.0224038292 -0.038135105 -1.748916e-02
## 2016-11-30 -0.0259895882 -0.0451619817 -0.0179743747 0.125246377 3.617632e-02
## 2016-12-30 0.0025376806 -0.0025298839 0.0267029860 0.031492070 2.006892e-02
## 2017-01-31 0.0021262501 0.0644317083 0.0323818248 -0.012143851 1.773628e-02
## 2017-02-28 0.0064380934 0.0172576136 0.0118363766 0.013428561 3.853927e-02
## 2017-03-31 -0.0005528882 0.0361889541 0.0318056779 -0.006532991 1.249362e-03
## 2017-04-28 0.0090292201 0.0168664410 0.0239521080 0.005107722 9.877204e-03
## 2017-05-31 0.0068471687 0.0280599501 0.0348103321 -0.022862541 1.401413e-02
## 2017-06-30 -0.0001825268 0.0092237243 0.0029559205 0.029151704 6.354830e-03
## 2017-07-31 0.0033342263 0.0565945218 0.0261878665 0.007481815 2.034560e-02
## 2017-08-31 0.0093693522 0.0232439051 -0.0004482412 -0.027564867 2.913657e-03
## 2017-09-29 -0.0057318591 -0.0004462721 0.0233429013 0.082321790 1.994908e-02
## 2017-10-31 0.0009778703 0.0322782299 0.0166536329 0.005915794 2.329065e-02
## 2017-11-30 -0.0014844120 -0.0038968556 0.0068698672 0.036913283 3.010781e-02
## 2017-12-29 0.0047404186 0.0369253762 0.0133982950 -0.003731152 1.205532e-02# Covariance of asset returns
covariance_matrix <- cov(asset_returns_wide_tbl)
covariance_matrix## AGG EEM EFA IJS SPY
## AGG 7.398309e-05 0.0001042083 4.178065e-05 -7.811828e-05 -9.032123e-06
## EEM 1.042083e-04 0.0017547135 1.039017e-03 6.437732e-04 6.795419e-04
## EFA 4.178065e-05 0.0010390170 1.064237e-03 6.490293e-04 6.975392e-04
## IJS -7.811828e-05 0.0006437732 6.490293e-04 1.565452e-03 8.290261e-04
## SPY -9.032123e-06 0.0006795419 6.975392e-04 8.290261e-04 7.408287e-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.0003874043 0.009257149 0.005815628 0.005684475 0.002330248rowSums(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.0062310524 -0.0029352692 0.0366063564 0.052133154 4.992337e-02
## 2013-02-28 0.0058912134 -0.0231054098 -0.0129695801 0.016175426 1.267819e-02
## 2013-03-28 0.0009851343 -0.0102348139 0.0129695801 0.040258440 3.726775e-02
## 2013-04-30 0.0096386859 0.0120847573 0.0489678170 0.001222017 1.903006e-02
## 2013-05-31 -0.0202139164 -0.0494836985 -0.0306558292 0.041976433 2.333574e-02
## 2013-06-28 -0.0157783176 -0.0547282506 -0.0271445635 -0.001402890 -1.343439e-02
## 2013-07-31 0.0026876845 0.0131597901 0.0518603767 0.063541728 5.038550e-02
## 2013-08-30 -0.0082980656 -0.0257057055 -0.0197461583 -0.034743888 -3.045106e-02
## 2013-09-30 0.0111437973 0.0695887562 0.0753385111 0.063873735 3.115599e-02
## 2013-10-31 0.0082920612 0.0408614986 0.0320815933 0.034234128 4.526658e-02
## 2013-11-29 -0.0025093522 -0.0025938763 0.0054496052 0.041661011 2.920693e-02
## 2013-12-31 -0.0055833798 -0.0040745011 0.0215284048 0.012892173 2.559598e-02
## 2014-01-31 0.0152914611 -0.0903227504 -0.0534133833 -0.035775366 -3.588432e-02
## 2014-02-28 0.0037571041 0.0332206284 0.0595048163 0.045257435 4.451034e-02
## 2014-03-31 -0.0014817443 0.0380217395 -0.0046023586 0.013315483 8.261183e-03
## 2014-04-30 0.0081830919 0.0077727547 0.0165292256 -0.023184345 6.927299e-03
## 2014-05-30 0.0117216657 0.0290910772 0.0158285234 0.006205096 2.294126e-02
## 2014-06-30 -0.0005755729 0.0237337591 0.0091653784 0.037718821 2.043500e-02
## 2014-07-31 -0.0025124231 0.0135558056 -0.0263798025 -0.052009414 -1.352893e-02
## 2014-08-29 0.0114312053 0.0279047090 0.0018003362 0.043658018 3.870474e-02
## 2014-09-30 -0.0061672254 -0.0808568663 -0.0395981595 -0.061260437 -1.389213e-02
## 2014-10-31 0.0105842779 0.0140965828 -0.0026551373 0.068874655 2.327767e-02
## 2014-11-28 0.0065483279 -0.0155415306 0.0006253818 0.004773734 2.710148e-02
## 2014-12-31 0.0014760953 -0.0404419639 -0.0407468140 0.025296078 -2.539708e-03
## 2015-01-30 0.0203149361 -0.0068957397 0.0062265290 -0.054628018 -3.007729e-02
## 2015-02-27 -0.0089887149 0.0431361472 0.0614505688 0.056914316 5.468219e-02
## 2015-03-31 0.0037406598 -0.0150861191 -0.0143886299 0.010156569 -1.583039e-02
## 2015-04-30 -0.0032329931 0.0662815139 0.0358165978 -0.018417986 9.785922e-03
## 2015-05-29 -0.0043837538 -0.0419113061 0.0019527030 0.007510096 1.277362e-02
## 2015-06-30 -0.0108256616 -0.0297466055 -0.0316787390 0.004171254 -2.052083e-02
## 2015-07-31 0.0085847421 -0.0651780556 0.0201142260 -0.027375111 2.233803e-02
## 2015-08-31 -0.0033634851 -0.0925125549 -0.0771523511 -0.047268427 -6.288673e-02
## 2015-09-30 0.0080813224 -0.0318248313 -0.0451948403 -0.038464840 -2.584730e-02
## 2015-10-30 0.0006851102 0.0618083991 0.0640257790 0.063589994 8.163498e-02
## 2015-11-30 -0.0038981052 -0.0255606755 -0.0075557903 0.024414852 3.648443e-03
## 2015-12-31 -0.0019187850 -0.0389469649 -0.0235952752 -0.052156661 -1.743333e-02
## 2016-01-29 0.0123292979 -0.0516366464 -0.0567574803 -0.060307095 -5.106873e-02
## 2016-02-29 0.0088320617 -0.0082116587 -0.0339139916 0.020605316 -8.263021e-04
## 2016-03-31 0.0087087074 0.1218790760 0.0637456958 0.089910284 6.510019e-02
## 2016-04-29 0.0025465859 0.0040792259 0.0219749876 0.021044338 3.933327e-03
## 2016-05-31 0.0001355704 -0.0376284898 -0.0008559461 0.004396881 1.686871e-02
## 2016-06-30 0.0191663196 0.0445825435 -0.0244916585 0.008292501 3.469718e-03
## 2016-07-29 0.0054298813 0.0524417392 0.0390004967 0.049348213 3.582192e-02
## 2016-08-31 -0.0021566513 0.0087985863 0.0053267526 0.011261212 1.196872e-03
## 2016-09-30 0.0005162292 0.0248731059 0.0132791199 0.008614675 5.799761e-05
## 2016-10-31 -0.0082050351 -0.0083122584 -0.0224038292 -0.038135105 -1.748916e-02
## 2016-11-30 -0.0259895882 -0.0451619817 -0.0179743747 0.125246377 3.617632e-02
## 2016-12-30 0.0025376806 -0.0025298839 0.0267029860 0.031492070 2.006892e-02
## 2017-01-31 0.0021262501 0.0644317083 0.0323818248 -0.012143851 1.773628e-02
## 2017-02-28 0.0064380934 0.0172576136 0.0118363766 0.013428561 3.853927e-02
## 2017-03-31 -0.0005528882 0.0361889541 0.0318056779 -0.006532991 1.249362e-03
## 2017-04-28 0.0090292201 0.0168664410 0.0239521080 0.005107722 9.877204e-03
## 2017-05-31 0.0068471687 0.0280599501 0.0348103321 -0.022862541 1.401413e-02
## 2017-06-30 -0.0001825268 0.0092237243 0.0029559205 0.029151704 6.354830e-03
## 2017-07-31 0.0033342263 0.0565945218 0.0261878665 0.007481815 2.034560e-02
## 2017-08-31 0.0093693522 0.0232439051 -0.0004482412 -0.027564867 2.913657e-03
## 2017-09-29 -0.0057318591 -0.0004462721 0.0233429013 0.082321790 1.994908e-02
## 2017-10-31 0.0009778703 0.0322782299 0.0166536329 0.005915794 2.329065e-02
## 2017-11-30 -0.0014844120 -0.0038968556 0.0068698672 0.036913283 3.010781e-02
## 2017-12-29 0.0047404186 0.0369253762 0.0133982950 -0.003731152 1.205532e-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
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")
6 Rolling 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") %>%
# 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)