Week 14: Code along 12
CHAPTER 10 Component Contribution to Standard Deviation
Cody Grube
2022-04-22
# 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.0062306314 -0.002935305 0.0366060875 0.052133264 4.992316e-02
## 2013-02-28 0.0058908035 -0.023105392 -0.0129692147 0.016175400 1.267825e-02
## 2013-03-28 0.0009849638 -0.010235011 0.0129692147 0.040258345 3.726807e-02
## 2013-04-30 0.0096390546 0.012085007 0.0489677868 0.001222188 1.902974e-02
## 2013-05-31 -0.0202137539 -0.049483766 -0.0306555691 0.041976530 2.333530e-02
## 2013-06-28 -0.0157784206 -0.054728110 -0.0271444696 -0.001402535 -1.343398e-02
## 2013-07-31 0.0026876276 0.013159871 0.0518604473 0.063540766 5.038569e-02
## 2013-08-30 -0.0082978704 -0.025705865 -0.0197463047 -0.034743291 -3.045134e-02
## 2013-09-30 0.0111435579 0.069588817 0.0753384249 0.063873968 3.115617e-02
## 2013-10-31 0.0082917436 0.040861379 0.0320817729 0.034233729 4.526656e-02
## 2013-11-29 -0.0025089902 -0.002594078 0.0054494707 0.041661359 2.920696e-02
## 2013-12-31 -0.0055832561 -0.004074306 0.0215281466 0.012891904 2.559591e-02
## 2014-01-31 0.0152910857 -0.090322617 -0.0534132683 -0.035774979 -3.588413e-02
## 2014-02-28 0.0037571143 0.033220545 0.0595049624 0.045257174 4.451030e-02
## 2014-03-31 -0.0014812352 0.038021743 -0.0046025474 0.013315157 8.261304e-03
## 2014-04-30 0.0081823277 0.007772674 0.0165292862 -0.023184373 6.927369e-03
## 2014-05-30 0.0117220843 0.029091075 0.0158285726 0.006205609 2.294136e-02
## 2014-06-30 -0.0005754682 0.023733840 0.0091654311 0.037718886 2.043454e-02
## 2014-07-31 -0.0025125967 0.013555882 -0.0263798667 -0.052009541 -1.352850e-02
## 2014-08-29 0.0114311973 0.027904488 0.0018004570 0.043657585 3.870444e-02
## 2014-09-30 -0.0061674157 -0.080856677 -0.0395983857 -0.061260402 -1.389245e-02
## 2014-10-31 0.0105846017 0.014096336 -0.0026548780 0.068875014 2.327780e-02
## 2014-11-28 0.0065490965 -0.015541103 0.0006250936 0.004773469 2.710165e-02
## 2014-12-31 0.0014747812 -0.040442089 -0.0407465225 0.025295910 -2.539852e-03
## 2015-01-30 0.0203152665 -0.006895986 0.0062264243 -0.054627908 -3.007703e-02
## 2015-02-27 -0.0089883391 0.043136042 0.0614505961 0.056914589 5.468160e-02
## 2015-03-31 0.0037400778 -0.015086012 -0.0143888431 0.010156557 -1.583013e-02
## 2015-04-30 -0.0032328970 0.066281251 0.0358167281 -0.018417838 9.785980e-03
## 2015-05-29 -0.0043837534 -0.041911241 0.0019524660 0.007509950 1.277409e-02
## 2015-06-30 -0.0108256339 -0.029746219 -0.0316786668 0.004171322 -2.052117e-02
## 2015-07-31 0.0085850587 -0.065178232 0.0201146592 -0.027375469 2.233806e-02
## 2015-08-31 -0.0033642812 -0.092512493 -0.0771525831 -0.047268307 -6.288676e-02
## 2015-09-30 0.0080813436 -0.031824745 -0.0451948648 -0.038464771 -2.584729e-02
## 2015-10-30 0.0006857591 0.061808283 0.0640258646 0.063589835 8.163488e-02
## 2015-11-30 -0.0038980409 -0.025560530 -0.0075557159 0.024415263 3.648591e-03
## 2015-12-31 -0.0019189967 -0.038947072 -0.0235951175 -0.052156958 -1.743371e-02
## 2016-01-29 0.0123298047 -0.051636707 -0.0567578987 -0.060307008 -5.106836e-02
## 2016-02-29 0.0088319333 -0.008211740 -0.0339138083 0.020605361 -8.264511e-04
## 2016-03-31 0.0087085582 0.121879089 0.0637455063 0.089910288 6.510018e-02
## 2016-04-29 0.0025466008 0.004079408 0.0219751221 0.021044059 3.933533e-03
## 2016-05-31 0.0001356920 -0.037628640 -0.0008559765 0.004397249 1.686856e-02
## 2016-06-30 0.0191663262 0.044582331 -0.0244915550 0.008292171 3.469886e-03
## 2016-07-29 0.0054299382 0.052442435 0.0390002810 0.049348448 3.582179e-02
## 2016-08-31 -0.0021564351 0.008798294 0.0053268348 0.011261274 1.196798e-03
## 2016-09-30 0.0005158489 0.024872943 0.0132789516 0.008614620 5.797534e-05
## 2016-10-31 -0.0082046963 -0.008312118 -0.0224034935 -0.038134906 -1.748893e-02
## 2016-11-30 -0.0259896420 -0.045161868 -0.0179745171 0.125246410 3.617611e-02
## 2016-12-30 0.0025372119 -0.002529895 0.0267030288 0.031491799 2.006893e-02
## 2017-01-31 0.0021263762 0.064431408 0.0323817065 -0.012143788 1.773665e-02
## 2017-02-28 0.0064381603 0.017257767 0.0118363957 0.013428522 3.853903e-02
## 2017-03-31 -0.0005531218 0.036189001 0.0318058841 -0.006532843 1.249204e-03
## 2017-04-28 0.0090296117 0.016866382 0.0239521715 0.005107638 9.877110e-03
## 2017-05-31 0.0068471626 0.028059772 0.0348101317 -0.022862487 1.401455e-02
## 2017-06-30 -0.0001828178 0.009223718 0.0029559935 0.029151645 6.354431e-03
## 2017-07-31 0.0033347077 0.056594597 0.0261881023 0.007481553 2.034593e-02
## 2017-08-31 0.0093691387 0.023243796 -0.0004484348 -0.027564864 2.913331e-03
## 2017-09-29 -0.0057324398 -0.000446368 0.0233427115 0.082321631 1.994945e-02
## 2017-10-31 0.0009778856 0.032278690 0.0166537760 0.005916319 2.329052e-02
## 2017-11-30 -0.0014837374 -0.003896947 0.0068700030 0.036913080 3.010792e-02
## 2017-12-29 0.0047399778 0.036925502 0.0133982347 -0.003730891 1.205503e-02# Covariance of asset returns
covariance_matrix <- cov(asset_returns_wide_tbl)
covariance_matrix## AGG EEM EFA IJS SPY
## AGG 7.398310e-05 0.0001042111 4.178378e-05 -7.811797e-05 -9.028725e-06
## EEM 1.042111e-04 0.0017547119 1.039017e-03 6.437721e-04 6.795417e-04
## EFA 4.178378e-05 0.0010390167 1.064237e-03 6.490280e-04 6.975393e-04
## IJS -7.811797e-05 0.0006437721 6.490280e-04 1.565448e-03 8.290226e-04
## SPY -9.028725e-06 0.0006795417 6.975393e-04 8.290226e-04 7.408262e-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.0003874227 0.009257147 0.005815631 0.005684462 0.002330247rowSums(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.0062306314 -0.002935305 0.0366060875 0.052133264 4.992316e-02
## 2013-02-28 0.0058908035 -0.023105392 -0.0129692147 0.016175400 1.267825e-02
## 2013-03-28 0.0009849638 -0.010235011 0.0129692147 0.040258345 3.726807e-02
## 2013-04-30 0.0096390546 0.012085007 0.0489677868 0.001222188 1.902974e-02
## 2013-05-31 -0.0202137539 -0.049483766 -0.0306555691 0.041976530 2.333530e-02
## 2013-06-28 -0.0157784206 -0.054728110 -0.0271444696 -0.001402535 -1.343398e-02
## 2013-07-31 0.0026876276 0.013159871 0.0518604473 0.063540766 5.038569e-02
## 2013-08-30 -0.0082978704 -0.025705865 -0.0197463047 -0.034743291 -3.045134e-02
## 2013-09-30 0.0111435579 0.069588817 0.0753384249 0.063873968 3.115617e-02
## 2013-10-31 0.0082917436 0.040861379 0.0320817729 0.034233729 4.526656e-02
## 2013-11-29 -0.0025089902 -0.002594078 0.0054494707 0.041661359 2.920696e-02
## 2013-12-31 -0.0055832561 -0.004074306 0.0215281466 0.012891904 2.559591e-02
## 2014-01-31 0.0152910857 -0.090322617 -0.0534132683 -0.035774979 -3.588413e-02
## 2014-02-28 0.0037571143 0.033220545 0.0595049624 0.045257174 4.451030e-02
## 2014-03-31 -0.0014812352 0.038021743 -0.0046025474 0.013315157 8.261304e-03
## 2014-04-30 0.0081823277 0.007772674 0.0165292862 -0.023184373 6.927369e-03
## 2014-05-30 0.0117220843 0.029091075 0.0158285726 0.006205609 2.294136e-02
## 2014-06-30 -0.0005754682 0.023733840 0.0091654311 0.037718886 2.043454e-02
## 2014-07-31 -0.0025125967 0.013555882 -0.0263798667 -0.052009541 -1.352850e-02
## 2014-08-29 0.0114311973 0.027904488 0.0018004570 0.043657585 3.870444e-02
## 2014-09-30 -0.0061674157 -0.080856677 -0.0395983857 -0.061260402 -1.389245e-02
## 2014-10-31 0.0105846017 0.014096336 -0.0026548780 0.068875014 2.327780e-02
## 2014-11-28 0.0065490965 -0.015541103 0.0006250936 0.004773469 2.710165e-02
## 2014-12-31 0.0014747812 -0.040442089 -0.0407465225 0.025295910 -2.539852e-03
## 2015-01-30 0.0203152665 -0.006895986 0.0062264243 -0.054627908 -3.007703e-02
## 2015-02-27 -0.0089883391 0.043136042 0.0614505961 0.056914589 5.468160e-02
## 2015-03-31 0.0037400778 -0.015086012 -0.0143888431 0.010156557 -1.583013e-02
## 2015-04-30 -0.0032328970 0.066281251 0.0358167281 -0.018417838 9.785980e-03
## 2015-05-29 -0.0043837534 -0.041911241 0.0019524660 0.007509950 1.277409e-02
## 2015-06-30 -0.0108256339 -0.029746219 -0.0316786668 0.004171322 -2.052117e-02
## 2015-07-31 0.0085850587 -0.065178232 0.0201146592 -0.027375469 2.233806e-02
## 2015-08-31 -0.0033642812 -0.092512493 -0.0771525831 -0.047268307 -6.288676e-02
## 2015-09-30 0.0080813436 -0.031824745 -0.0451948648 -0.038464771 -2.584729e-02
## 2015-10-30 0.0006857591 0.061808283 0.0640258646 0.063589835 8.163488e-02
## 2015-11-30 -0.0038980409 -0.025560530 -0.0075557159 0.024415263 3.648591e-03
## 2015-12-31 -0.0019189967 -0.038947072 -0.0235951175 -0.052156958 -1.743371e-02
## 2016-01-29 0.0123298047 -0.051636707 -0.0567578987 -0.060307008 -5.106836e-02
## 2016-02-29 0.0088319333 -0.008211740 -0.0339138083 0.020605361 -8.264511e-04
## 2016-03-31 0.0087085582 0.121879089 0.0637455063 0.089910288 6.510018e-02
## 2016-04-29 0.0025466008 0.004079408 0.0219751221 0.021044059 3.933533e-03
## 2016-05-31 0.0001356920 -0.037628640 -0.0008559765 0.004397249 1.686856e-02
## 2016-06-30 0.0191663262 0.044582331 -0.0244915550 0.008292171 3.469886e-03
## 2016-07-29 0.0054299382 0.052442435 0.0390002810 0.049348448 3.582179e-02
## 2016-08-31 -0.0021564351 0.008798294 0.0053268348 0.011261274 1.196798e-03
## 2016-09-30 0.0005158489 0.024872943 0.0132789516 0.008614620 5.797534e-05
## 2016-10-31 -0.0082046963 -0.008312118 -0.0224034935 -0.038134906 -1.748893e-02
## 2016-11-30 -0.0259896420 -0.045161868 -0.0179745171 0.125246410 3.617611e-02
## 2016-12-30 0.0025372119 -0.002529895 0.0267030288 0.031491799 2.006893e-02
## 2017-01-31 0.0021263762 0.064431408 0.0323817065 -0.012143788 1.773665e-02
## 2017-02-28 0.0064381603 0.017257767 0.0118363957 0.013428522 3.853903e-02
## 2017-03-31 -0.0005531218 0.036189001 0.0318058841 -0.006532843 1.249204e-03
## 2017-04-28 0.0090296117 0.016866382 0.0239521715 0.005107638 9.877110e-03
## 2017-05-31 0.0068471626 0.028059772 0.0348101317 -0.022862487 1.401455e-02
## 2017-06-30 -0.0001828178 0.009223718 0.0029559935 0.029151645 6.354431e-03
## 2017-07-31 0.0033347077 0.056594597 0.0261881023 0.007481553 2.034593e-02
## 2017-08-31 0.0093691387 0.023243796 -0.0004484348 -0.027564864 2.913331e-03
## 2017-09-29 -0.0057324398 -0.000446368 0.0233427115 0.082321631 1.994945e-02
## 2017-10-31 0.0009778856 0.032278690 0.0166537760 0.005916319 2.329052e-02
## 2017-11-30 -0.0014837374 -0.003896947 0.0068700030 0.036913080 3.010792e-02
## 2017-12-29 0.0047399778 0.036925502 0.0133982347 -0.003730891 1.205503e-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")## $title
## [1] "Percent Contribution to Portfolio Volatility"
##
## attr(,"class")
## [1] "labels"6 Rolling Component Contribution
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) 