Week 14: Code along 12
CHAPTER 10 Component Contribution to Standard Deviation
Reed Wilson
2023-04-24
# 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.0062303659 -0.0029358481 0.0366062698 0.052132821 4.992303e-02
## 2013-02-28 0.0058908933 -0.0231051733 -0.0129693922 0.016175805 1.267813e-02
## 2013-03-28 0.0009846047 -0.0102349101 0.0129693922 0.040258337 3.726807e-02
## 2013-04-30 0.0096394033 0.0120845666 0.0489678681 0.001222295 1.903032e-02
## 2013-05-31 -0.0202138371 -0.0494837606 -0.0306558345 0.041976139 2.333484e-02
## 2013-06-28 -0.0157784197 -0.0547277103 -0.0271444622 -0.001403216 -1.343410e-02
## 2013-07-31 0.0026875367 0.0131595892 0.0518606179 0.063541622 5.038614e-02
## 2013-08-30 -0.0082979581 -0.0257056818 -0.0197465622 -0.034743293 -3.045122e-02
## 2013-09-30 0.0111435612 0.0695889691 0.0753385957 0.063873791 3.115540e-02
## 2013-10-31 0.0082924571 0.0408610446 0.0320818492 0.034233886 4.526668e-02
## 2013-11-29 -0.0025099712 -0.0025940735 0.0054496382 0.041660956 2.920697e-02
## 2013-12-31 -0.0055832530 -0.0040740977 0.0215279917 0.012891898 2.559631e-02
## 2014-01-31 0.0152921420 -0.0903226002 -0.0534131976 -0.035775071 -3.588443e-02
## 2014-02-28 0.0037565894 0.0332204261 0.0595049505 0.045257591 4.451030e-02
## 2014-03-31 -0.0014815030 0.0380216202 -0.0046026026 0.013315075 8.261115e-03
## 2014-04-30 0.0081832922 0.0077725612 0.0165291345 -0.023184055 6.927463e-03
## 2014-05-30 0.0117217297 0.0290915367 0.0158289367 0.006205219 2.294127e-02
## 2014-06-30 -0.0005759937 0.0237337276 0.0091650608 0.037718806 2.043491e-02
## 2014-07-31 -0.0025121615 0.0135555467 -0.0263798632 -0.052009395 -1.352887e-02
## 2014-08-29 0.0114310279 0.0279047091 0.0018005324 0.043657903 3.870489e-02
## 2014-09-30 -0.0061674215 -0.0808567758 -0.0395983223 -0.061260545 -1.389244e-02
## 2014-10-31 0.0105840050 0.0140965399 -0.0026550900 0.068874688 2.327789e-02
## 2014-11-28 0.0065494402 -0.0155414364 0.0006255330 0.004773624 2.710147e-02
## 2014-12-31 0.0014746140 -0.0404419772 -0.0407467494 0.025295904 -2.540202e-03
## 2015-01-30 0.0203149341 -0.0068956260 0.0062264210 -0.054627823 -3.007677e-02
## 2015-02-27 -0.0089879263 0.0431358088 0.0614506078 0.056914288 5.468186e-02
## 2015-03-31 0.0037401669 -0.0150859161 -0.0143886921 0.010156628 -1.583013e-02
## 2015-04-30 -0.0032331470 0.0662811397 0.0358165742 -0.018417754 9.785720e-03
## 2015-05-29 -0.0043830876 -0.0419107844 0.0019526162 0.007509952 1.277442e-02
## 2015-06-30 -0.0108257194 -0.0297467732 -0.0316788826 0.004171395 -2.052150e-02
## 2015-07-31 0.0085848127 -0.0651782658 0.0201145890 -0.027375551 2.233789e-02
## 2015-08-31 -0.0033637820 -0.0925122254 -0.0771524538 -0.047267928 -6.288650e-02
## 2015-09-30 0.0080808425 -0.0318250033 -0.0451950173 -0.038464921 -2.584711e-02
## 2015-10-30 0.0006858430 0.0618083397 0.0640260956 0.063589685 8.163461e-02
## 2015-11-30 -0.0038985525 -0.0255606021 -0.0075559415 0.024415112 3.648678e-03
## 2015-12-31 -0.0019185694 -0.0389470505 -0.0235950350 -0.052156893 -1.743354e-02
## 2016-01-29 0.0123301269 -0.0516364977 -0.0567577476 -0.060306852 -5.106879e-02
## 2016-02-29 0.0088314454 -0.0082116903 -0.0339139805 0.020605130 -8.261809e-04
## 2016-03-31 0.0087091216 0.1218789414 0.0637457629 0.089910297 6.510009e-02
## 2016-04-29 0.0025458739 0.0040792904 0.0219751200 0.021044425 3.933699e-03
## 2016-05-31 0.0001354421 -0.0376285672 -0.0008562895 0.004396886 1.686830e-02
## 2016-06-30 0.0191669805 0.0445824358 -0.0244913251 0.008292325 3.469889e-03
## 2016-07-29 0.0054294615 0.0524422474 0.0390001135 0.049348431 3.582179e-02
## 2016-08-31 -0.0021563580 0.0087985990 0.0053270889 0.011261086 1.196641e-03
## 2016-09-30 0.0005161677 0.0248727823 0.0132789403 0.008614605 5.829313e-05
## 2016-10-31 -0.0082051778 -0.0083123542 -0.0224037254 -0.038134764 -1.748877e-02
## 2016-11-30 -0.0259898165 -0.0451614994 -0.0179743636 0.125246347 3.617571e-02
## 2016-12-30 0.0025381132 -0.0025302862 0.0267028055 0.031491683 2.006923e-02
## 2017-01-31 0.0021262126 0.0644317880 0.0323819981 -0.012143655 1.773635e-02
## 2017-02-28 0.0064378344 0.0172576477 0.0118363213 0.013428813 3.853925e-02
## 2017-03-31 -0.0005529565 0.0361891103 0.0318056750 -0.006533133 1.249064e-03
## 2017-04-28 0.0090292883 0.0168660541 0.0239522359 0.005107630 9.877395e-03
## 2017-05-31 0.0068474874 0.0280600769 0.0348101456 -0.022862434 1.401412e-02
## 2017-06-30 -0.0001825774 0.0092236128 0.0029559227 0.029151655 6.354713e-03
## 2017-07-31 0.0033339074 0.0565944996 0.0261879714 0.007481853 2.034592e-02
## 2017-08-31 0.0093694574 0.0232438118 -0.0004481744 -0.027564989 2.913533e-03
## 2017-09-29 -0.0057319612 -0.0004460777 0.0233425824 0.082321960 1.994892e-02
## 2017-10-31 0.0009774083 0.0322784865 0.0166537754 0.005915650 2.329085e-02
## 2017-11-30 -0.0014839033 -0.0038969510 0.0068699364 0.036913622 3.010798e-02
## 2017-12-29 0.0047404633 0.0369253399 0.0133986151 -0.003731529 1.205490e-02# Covariance of asset returns
covariance_matrix <- cov(asset_returns_wide_tbl)
covariance_matrix## AGG EEM EFA IJS SPY
## AGG 7.398395e-05 0.0001042096 4.178355e-05 -7.812016e-05 -9.029744e-06
## EEM 1.042096e-04 0.0017547083 1.039017e-03 6.437723e-04 6.795407e-04
## EFA 4.178355e-05 0.0010390166 1.064239e-03 6.490288e-04 6.975408e-04
## IJS -7.812016e-05 0.0006437723 6.490288e-04 1.565448e-03 8.290215e-04
## SPY -9.029744e-06 0.0006795407 6.975408e-04 8.290215e-04 7.408265e-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.0003874147 0.009257137 0.005815639 0.00568446 0.002330246rowSums(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.0062303659 -0.0029358481 0.0366062698 0.052132821 4.992303e-02
## 2013-02-28 0.0058908933 -0.0231051733 -0.0129693922 0.016175805 1.267813e-02
## 2013-03-28 0.0009846047 -0.0102349101 0.0129693922 0.040258337 3.726807e-02
## 2013-04-30 0.0096394033 0.0120845666 0.0489678681 0.001222295 1.903032e-02
## 2013-05-31 -0.0202138371 -0.0494837606 -0.0306558345 0.041976139 2.333484e-02
## 2013-06-28 -0.0157784197 -0.0547277103 -0.0271444622 -0.001403216 -1.343410e-02
## 2013-07-31 0.0026875367 0.0131595892 0.0518606179 0.063541622 5.038614e-02
## 2013-08-30 -0.0082979581 -0.0257056818 -0.0197465622 -0.034743293 -3.045122e-02
## 2013-09-30 0.0111435612 0.0695889691 0.0753385957 0.063873791 3.115540e-02
## 2013-10-31 0.0082924571 0.0408610446 0.0320818492 0.034233886 4.526668e-02
## 2013-11-29 -0.0025099712 -0.0025940735 0.0054496382 0.041660956 2.920697e-02
## 2013-12-31 -0.0055832530 -0.0040740977 0.0215279917 0.012891898 2.559631e-02
## 2014-01-31 0.0152921420 -0.0903226002 -0.0534131976 -0.035775071 -3.588443e-02
## 2014-02-28 0.0037565894 0.0332204261 0.0595049505 0.045257591 4.451030e-02
## 2014-03-31 -0.0014815030 0.0380216202 -0.0046026026 0.013315075 8.261115e-03
## 2014-04-30 0.0081832922 0.0077725612 0.0165291345 -0.023184055 6.927463e-03
## 2014-05-30 0.0117217297 0.0290915367 0.0158289367 0.006205219 2.294127e-02
## 2014-06-30 -0.0005759937 0.0237337276 0.0091650608 0.037718806 2.043491e-02
## 2014-07-31 -0.0025121615 0.0135555467 -0.0263798632 -0.052009395 -1.352887e-02
## 2014-08-29 0.0114310279 0.0279047091 0.0018005324 0.043657903 3.870489e-02
## 2014-09-30 -0.0061674215 -0.0808567758 -0.0395983223 -0.061260545 -1.389244e-02
## 2014-10-31 0.0105840050 0.0140965399 -0.0026550900 0.068874688 2.327789e-02
## 2014-11-28 0.0065494402 -0.0155414364 0.0006255330 0.004773624 2.710147e-02
## 2014-12-31 0.0014746140 -0.0404419772 -0.0407467494 0.025295904 -2.540202e-03
## 2015-01-30 0.0203149341 -0.0068956260 0.0062264210 -0.054627823 -3.007677e-02
## 2015-02-27 -0.0089879263 0.0431358088 0.0614506078 0.056914288 5.468186e-02
## 2015-03-31 0.0037401669 -0.0150859161 -0.0143886921 0.010156628 -1.583013e-02
## 2015-04-30 -0.0032331470 0.0662811397 0.0358165742 -0.018417754 9.785720e-03
## 2015-05-29 -0.0043830876 -0.0419107844 0.0019526162 0.007509952 1.277442e-02
## 2015-06-30 -0.0108257194 -0.0297467732 -0.0316788826 0.004171395 -2.052150e-02
## 2015-07-31 0.0085848127 -0.0651782658 0.0201145890 -0.027375551 2.233789e-02
## 2015-08-31 -0.0033637820 -0.0925122254 -0.0771524538 -0.047267928 -6.288650e-02
## 2015-09-30 0.0080808425 -0.0318250033 -0.0451950173 -0.038464921 -2.584711e-02
## 2015-10-30 0.0006858430 0.0618083397 0.0640260956 0.063589685 8.163461e-02
## 2015-11-30 -0.0038985525 -0.0255606021 -0.0075559415 0.024415112 3.648678e-03
## 2015-12-31 -0.0019185694 -0.0389470505 -0.0235950350 -0.052156893 -1.743354e-02
## 2016-01-29 0.0123301269 -0.0516364977 -0.0567577476 -0.060306852 -5.106879e-02
## 2016-02-29 0.0088314454 -0.0082116903 -0.0339139805 0.020605130 -8.261809e-04
## 2016-03-31 0.0087091216 0.1218789414 0.0637457629 0.089910297 6.510009e-02
## 2016-04-29 0.0025458739 0.0040792904 0.0219751200 0.021044425 3.933699e-03
## 2016-05-31 0.0001354421 -0.0376285672 -0.0008562895 0.004396886 1.686830e-02
## 2016-06-30 0.0191669805 0.0445824358 -0.0244913251 0.008292325 3.469889e-03
## 2016-07-29 0.0054294615 0.0524422474 0.0390001135 0.049348431 3.582179e-02
## 2016-08-31 -0.0021563580 0.0087985990 0.0053270889 0.011261086 1.196641e-03
## 2016-09-30 0.0005161677 0.0248727823 0.0132789403 0.008614605 5.829313e-05
## 2016-10-31 -0.0082051778 -0.0083123542 -0.0224037254 -0.038134764 -1.748877e-02
## 2016-11-30 -0.0259898165 -0.0451614994 -0.0179743636 0.125246347 3.617571e-02
## 2016-12-30 0.0025381132 -0.0025302862 0.0267028055 0.031491683 2.006923e-02
## 2017-01-31 0.0021262126 0.0644317880 0.0323819981 -0.012143655 1.773635e-02
## 2017-02-28 0.0064378344 0.0172576477 0.0118363213 0.013428813 3.853925e-02
## 2017-03-31 -0.0005529565 0.0361891103 0.0318056750 -0.006533133 1.249064e-03
## 2017-04-28 0.0090292883 0.0168660541 0.0239522359 0.005107630 9.877395e-03
## 2017-05-31 0.0068474874 0.0280600769 0.0348101456 -0.022862434 1.401412e-02
## 2017-06-30 -0.0001825774 0.0092236128 0.0029559227 0.029151655 6.354713e-03
## 2017-07-31 0.0033339074 0.0565944996 0.0261879714 0.007481853 2.034592e-02
## 2017-08-31 0.0093694574 0.0232438118 -0.0004481744 -0.027564989 2.913533e-03
## 2017-09-29 -0.0057319612 -0.0004460777 0.0233425824 0.082321960 1.994892e-02
## 2017-10-31 0.0009774083 0.0322784865 0.0166537754 0.005915650 2.329085e-02
## 2017-11-30 -0.0014839033 -0.0038969510 0.0068699364 0.036913622 3.010798e-02
## 2017-12-29 0.0047404633 0.0369253399 0.0133986151 -0.003731529 1.205490e-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 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 <- 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 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(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)