Week 14: Code along 12
CHAPTER 10 Component Contribution to Standard Deviation
Daniel Lee
2022-09-19
# 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.0062308150 -0.0029356838 0.0366064856 0.052132890 4.992337e-02
## 2013-02-28 0.0058911696 -0.0231051198 -0.0129696594 0.016175778 1.267792e-02
## 2013-03-28 0.0009845151 -0.0102350096 0.0129696594 0.040258198 3.726780e-02
## 2013-04-30 0.0096392466 0.0120845638 0.0489674502 0.001222264 1.903030e-02
## 2013-05-31 -0.0202141935 -0.0494835016 -0.0306555106 0.041976583 2.333550e-02
## 2013-06-28 -0.0157781565 -0.0547283983 -0.0271445640 -0.001402752 -1.343458e-02
## 2013-07-31 0.0026880972 0.0131599494 0.0518604391 0.063541155 5.038611e-02
## 2013-08-30 -0.0082982869 -0.0257058023 -0.0197463768 -0.034743747 -3.045114e-02
## 2013-09-30 0.0111438890 0.0695890311 0.0753385871 0.063873757 3.115621e-02
## 2013-10-31 0.0082916556 0.0408612969 0.0320816361 0.034234287 4.526635e-02
## 2013-11-29 -0.0025095664 -0.0025941415 0.0054497013 0.041661174 2.920682e-02
## 2013-12-31 -0.0055829968 -0.0040743618 0.0215279768 0.012892044 2.559627e-02
## 2014-01-31 0.0152918009 -0.0903222466 -0.0534131431 -0.035775325 -3.588464e-02
## 2014-02-28 0.0037566419 0.0332201044 0.0595050034 0.045257415 4.451020e-02
## 2014-03-31 -0.0014813658 0.0380219391 -0.0046027210 0.013315354 8.261416e-03
## 2014-04-30 0.0081830887 0.0077723946 0.0165293717 -0.023184439 6.927372e-03
## 2014-05-30 0.0117212684 0.0290915352 0.0158286510 0.006205304 2.294138e-02
## 2014-06-30 -0.0005749634 0.0237339410 0.0091652585 0.037718882 2.043469e-02
## 2014-07-31 -0.0025125663 0.0135554632 -0.0263796293 -0.052009446 -1.352883e-02
## 2014-08-29 0.0114307684 0.0279043677 0.0018003463 0.043657812 3.870465e-02
## 2014-09-30 -0.0061680562 -0.0808564801 -0.0395986488 -0.061260380 -1.389201e-02
## 2014-10-31 0.0105853723 0.0140966785 -0.0026548115 0.068874663 2.327733e-02
## 2014-11-28 0.0065482529 -0.0155410658 0.0006253893 0.004773795 2.710176e-02
## 2014-12-31 0.0014749170 -0.0404426885 -0.0407467308 0.025295755 -2.539661e-03
## 2015-01-30 0.0203157151 -0.0068957375 0.0062265051 -0.054627975 -3.007725e-02
## 2015-02-27 -0.0089882748 0.0431364883 0.0614506173 0.056914793 5.468198e-02
## 2015-03-31 0.0037403336 -0.0150865983 -0.0143887061 0.010156313 -1.583054e-02
## 2015-04-30 -0.0032330288 0.0662815314 0.0358166550 -0.018417668 9.786040e-03
## 2015-05-29 -0.0043834705 -0.0419111291 0.0019524968 0.007509799 1.277405e-02
## 2015-06-30 -0.0108260735 -0.0297464970 -0.0316788276 0.004171521 -2.052110e-02
## 2015-07-31 0.0085847517 -0.0651780006 0.0201145601 -0.027375593 2.233772e-02
## 2015-08-31 -0.0033635524 -0.0925125919 -0.0771523212 -0.047268429 -6.288643e-02
## 2015-09-30 0.0080812015 -0.0318251356 -0.0451950615 -0.038464387 -2.584714e-02
## 2015-10-30 0.0006857377 0.0618086496 0.0640261348 0.063589469 8.163487e-02
## 2015-11-30 -0.0038985160 -0.0255606045 -0.0075560418 0.024415265 3.648363e-03
## 2015-12-31 -0.0019186283 -0.0389470337 -0.0235950294 -0.052156831 -1.743339e-02
## 2016-01-29 0.0123292138 -0.0516366758 -0.0567578198 -0.060307199 -5.106857e-02
## 2016-02-29 0.0088321046 -0.0082117558 -0.0339140842 0.020605378 -8.263021e-04
## 2016-03-31 0.0087092146 0.1218790692 0.0637457852 0.089910414 6.510006e-02
## 2016-04-29 0.0025461994 0.0040792829 0.0219751842 0.021044310 3.933565e-03
## 2016-05-31 0.0001355718 -0.0376284413 -0.0008560460 0.004397040 1.686846e-02
## 2016-06-30 0.0191662449 0.0445822695 -0.0244914502 0.008292326 3.469884e-03
## 2016-07-29 0.0054296978 0.0524420968 0.0390001108 0.049348375 3.582190e-02
## 2016-08-31 -0.0021560111 0.0087987255 0.0053270274 0.011260969 1.196574e-03
## 2016-09-30 0.0005158887 0.0248727521 0.0132791564 0.008614737 5.837816e-05
## 2016-10-31 -0.0082053141 -0.0083120694 -0.0224039124 -0.038135003 -1.748913e-02
## 2016-11-30 -0.0259897901 -0.0451618964 -0.0179745681 0.125246573 3.617606e-02
## 2016-12-30 0.0025385905 -0.0025301383 0.0267031121 0.031491677 2.006893e-02
## 2017-01-31 0.0021259009 0.0644317677 0.0323817944 -0.012143909 1.773654e-02
## 2017-02-28 0.0064379319 0.0172576588 0.0118363924 0.013428932 3.853926e-02
## 2017-03-31 -0.0005532178 0.0361893278 0.0318057133 -0.006533142 1.249013e-03
## 2017-04-28 0.0090296803 0.0168660577 0.0239522905 0.005107835 9.877237e-03
## 2017-05-31 0.0068470954 0.0280599865 0.0348102570 -0.022862750 1.401409e-02
## 2017-06-30 -0.0001826117 0.0092237649 0.0029558545 0.029151874 6.354976e-03
## 2017-07-31 0.0033343006 0.0565943378 0.0261877980 0.007481616 2.034593e-02
## 2017-08-31 0.0093693306 0.0232440751 -0.0004483634 -0.027564920 2.913308e-03
## 2017-09-29 -0.0057320856 -0.0004463953 0.0233428466 0.082321963 1.994921e-02
## 2017-10-31 0.0009774187 0.0322786679 0.0166537315 0.005915972 2.329061e-02
## 2017-11-30 -0.0014838915 -0.0038971454 0.0068699050 0.036913066 3.010800e-02
## 2017-12-29 0.0047403713 0.0369254897 0.0133984695 -0.003731026 1.205500e-02# Covariance of asset returns
covariance_matrix <- cov(asset_returns_wide_tbl)
covariance_matrix## AGG EEM EFA IJS SPY
## AGG 7.398441e-05 0.0001042113 4.178471e-05 -7.811614e-05 -9.029980e-06
## EEM 1.042113e-04 0.0017547136 1.039019e-03 6.437730e-04 6.795431e-04
## EFA 4.178471e-05 0.0010390188 1.064239e-03 6.490295e-04 6.975410e-04
## IJS -7.811614e-05 0.0006437730 6.490295e-04 1.565452e-03 8.290244e-04
## SPY -9.029980e-06 0.0006795431 6.975410e-04 8.290244e-04 7.408279e-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.02347494# 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.0003874308 0.009257149 0.005815638 0.00568447 0.002330248rowSums(component_contribution)## [1] 0.02347494# 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.0062308150 -0.0029356838 0.0366064856 0.052132890 4.992337e-02
## 2013-02-28 0.0058911696 -0.0231051198 -0.0129696594 0.016175778 1.267792e-02
## 2013-03-28 0.0009845151 -0.0102350096 0.0129696594 0.040258198 3.726780e-02
## 2013-04-30 0.0096392466 0.0120845638 0.0489674502 0.001222264 1.903030e-02
## 2013-05-31 -0.0202141935 -0.0494835016 -0.0306555106 0.041976583 2.333550e-02
## 2013-06-28 -0.0157781565 -0.0547283983 -0.0271445640 -0.001402752 -1.343458e-02
## 2013-07-31 0.0026880972 0.0131599494 0.0518604391 0.063541155 5.038611e-02
## 2013-08-30 -0.0082982869 -0.0257058023 -0.0197463768 -0.034743747 -3.045114e-02
## 2013-09-30 0.0111438890 0.0695890311 0.0753385871 0.063873757 3.115621e-02
## 2013-10-31 0.0082916556 0.0408612969 0.0320816361 0.034234287 4.526635e-02
## 2013-11-29 -0.0025095664 -0.0025941415 0.0054497013 0.041661174 2.920682e-02
## 2013-12-31 -0.0055829968 -0.0040743618 0.0215279768 0.012892044 2.559627e-02
## 2014-01-31 0.0152918009 -0.0903222466 -0.0534131431 -0.035775325 -3.588464e-02
## 2014-02-28 0.0037566419 0.0332201044 0.0595050034 0.045257415 4.451020e-02
## 2014-03-31 -0.0014813658 0.0380219391 -0.0046027210 0.013315354 8.261416e-03
## 2014-04-30 0.0081830887 0.0077723946 0.0165293717 -0.023184439 6.927372e-03
## 2014-05-30 0.0117212684 0.0290915352 0.0158286510 0.006205304 2.294138e-02
## 2014-06-30 -0.0005749634 0.0237339410 0.0091652585 0.037718882 2.043469e-02
## 2014-07-31 -0.0025125663 0.0135554632 -0.0263796293 -0.052009446 -1.352883e-02
## 2014-08-29 0.0114307684 0.0279043677 0.0018003463 0.043657812 3.870465e-02
## 2014-09-30 -0.0061680562 -0.0808564801 -0.0395986488 -0.061260380 -1.389201e-02
## 2014-10-31 0.0105853723 0.0140966785 -0.0026548115 0.068874663 2.327733e-02
## 2014-11-28 0.0065482529 -0.0155410658 0.0006253893 0.004773795 2.710176e-02
## 2014-12-31 0.0014749170 -0.0404426885 -0.0407467308 0.025295755 -2.539661e-03
## 2015-01-30 0.0203157151 -0.0068957375 0.0062265051 -0.054627975 -3.007725e-02
## 2015-02-27 -0.0089882748 0.0431364883 0.0614506173 0.056914793 5.468198e-02
## 2015-03-31 0.0037403336 -0.0150865983 -0.0143887061 0.010156313 -1.583054e-02
## 2015-04-30 -0.0032330288 0.0662815314 0.0358166550 -0.018417668 9.786040e-03
## 2015-05-29 -0.0043834705 -0.0419111291 0.0019524968 0.007509799 1.277405e-02
## 2015-06-30 -0.0108260735 -0.0297464970 -0.0316788276 0.004171521 -2.052110e-02
## 2015-07-31 0.0085847517 -0.0651780006 0.0201145601 -0.027375593 2.233772e-02
## 2015-08-31 -0.0033635524 -0.0925125919 -0.0771523212 -0.047268429 -6.288643e-02
## 2015-09-30 0.0080812015 -0.0318251356 -0.0451950615 -0.038464387 -2.584714e-02
## 2015-10-30 0.0006857377 0.0618086496 0.0640261348 0.063589469 8.163487e-02
## 2015-11-30 -0.0038985160 -0.0255606045 -0.0075560418 0.024415265 3.648363e-03
## 2015-12-31 -0.0019186283 -0.0389470337 -0.0235950294 -0.052156831 -1.743339e-02
## 2016-01-29 0.0123292138 -0.0516366758 -0.0567578198 -0.060307199 -5.106857e-02
## 2016-02-29 0.0088321046 -0.0082117558 -0.0339140842 0.020605378 -8.263021e-04
## 2016-03-31 0.0087092146 0.1218790692 0.0637457852 0.089910414 6.510006e-02
## 2016-04-29 0.0025461994 0.0040792829 0.0219751842 0.021044310 3.933565e-03
## 2016-05-31 0.0001355718 -0.0376284413 -0.0008560460 0.004397040 1.686846e-02
## 2016-06-30 0.0191662449 0.0445822695 -0.0244914502 0.008292326 3.469884e-03
## 2016-07-29 0.0054296978 0.0524420968 0.0390001108 0.049348375 3.582190e-02
## 2016-08-31 -0.0021560111 0.0087987255 0.0053270274 0.011260969 1.196574e-03
## 2016-09-30 0.0005158887 0.0248727521 0.0132791564 0.008614737 5.837816e-05
## 2016-10-31 -0.0082053141 -0.0083120694 -0.0224039124 -0.038135003 -1.748913e-02
## 2016-11-30 -0.0259897901 -0.0451618964 -0.0179745681 0.125246573 3.617606e-02
## 2016-12-30 0.0025385905 -0.0025301383 0.0267031121 0.031491677 2.006893e-02
## 2017-01-31 0.0021259009 0.0644317677 0.0323817944 -0.012143909 1.773654e-02
## 2017-02-28 0.0064379319 0.0172576588 0.0118363924 0.013428932 3.853926e-02
## 2017-03-31 -0.0005532178 0.0361893278 0.0318057133 -0.006533142 1.249013e-03
## 2017-04-28 0.0090296803 0.0168660577 0.0239522905 0.005107835 9.877237e-03
## 2017-05-31 0.0068470954 0.0280599865 0.0348102570 -0.022862750 1.401409e-02
## 2017-06-30 -0.0001826117 0.0092237649 0.0029558545 0.029151874 6.354976e-03
## 2017-07-31 0.0033343006 0.0565943378 0.0261877980 0.007481616 2.034593e-02
## 2017-08-31 0.0093693306 0.0232440751 -0.0004483634 -0.027564920 2.913308e-03
## 2017-09-29 -0.0057320856 -0.0004463953 0.0233428466 0.082321963 1.994921e-02
## 2017-10-31 0.0009774187 0.0322786679 0.0166537315 0.005915972 2.329061e-02
## 2017-11-30 -0.0014838915 -0.0038971454 0.0068699050 0.036913066 3.010800e-02
## 2017-12-29 0.0047403713 0.0369254897 0.0133984695 -0.003731026 1.205500e-02calculate_component_contribution <- function(.data, w) {
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") %>%
# 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",
y = "Percent",
x = NULL) ## $y
## [1] "Percent"
##
## $x
## NULL
##
## $title
## [1] "Percent Contribution to Portfolio Volatility"
##
## attr(,"class")
## [1] "labels"6 Rolling Component Contribution
Column C