Week 14: Code along 12
CHAPTER 10 Component Contribution to Standard Deviation
Takeru Ito
2025-11-17
# 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.0062302240 -0.0029357127 0.0366063164 0.052133325 4.992296e-02
## 2013-02-28 0.0058911508 -0.0231051182 -0.0129695702 0.016175344 1.267780e-02
## 2013-03-28 0.0009836600 -0.0102349968 0.0129695702 0.040258095 3.726831e-02
## 2013-04-30 0.0096395828 0.0120848926 0.0489678042 0.001222744 1.902975e-02
## 2013-05-31 -0.0202134083 -0.0494835176 -0.0306555900 0.041976287 2.333561e-02
## 2013-06-28 -0.0157784216 -0.0547282763 -0.0271446224 -0.001403198 -1.343419e-02
## 2013-07-31 0.0026877030 0.0131596056 0.0518604901 0.063541804 5.038593e-02
## 2013-08-30 -0.0082989704 -0.0257055117 -0.0197464230 -0.034743756 -3.045122e-02
## 2013-09-30 0.0111449249 0.0695887069 0.0753386957 0.063873622 3.115614e-02
## 2013-10-31 0.0082914090 0.0408612972 0.0320816546 0.034234254 4.526617e-02
## 2013-11-29 -0.0025093271 -0.0025940761 0.0054495994 0.041661406 2.920700e-02
## 2013-12-31 -0.0055824506 -0.0040745915 0.0215280075 0.012891961 2.559616e-02
## 2014-01-31 0.0152905131 -0.0903223016 -0.0534131839 -0.035775558 -3.588497e-02
## 2014-02-28 0.0037571330 0.0332204819 0.0595049187 0.045257429 4.451087e-02
## 2014-03-31 -0.0014816522 0.0380217584 -0.0046024134 0.013315472 8.261298e-03
## 2014-04-30 0.0081825909 0.0077725541 0.0165291842 -0.023184432 6.927060e-03
## 2014-05-30 0.0117219401 0.0290913110 0.0158285994 0.006205040 2.294127e-02
## 2014-06-30 -0.0005752720 0.0237338294 0.0091652618 0.037718977 2.043483e-02
## 2014-07-31 -0.0025118703 0.0135560224 -0.0263797347 -0.052009416 -1.352879e-02
## 2014-08-29 0.0114301494 0.0279042740 0.0018003981 0.043657784 3.870505e-02
## 2014-09-30 -0.0061671655 -0.0808568967 -0.0395985398 -0.061260399 -1.389227e-02
## 2014-10-31 0.0105848318 0.0140965746 -0.0026549338 0.068874727 2.327761e-02
## 2014-11-28 0.0065488009 -0.0155413274 0.0006255750 0.004773887 2.710114e-02
## 2014-12-31 0.0014749714 -0.0404419394 -0.0407468111 0.025295676 -2.539736e-03
## 2015-01-30 0.0203149892 -0.0068959422 0.0062265356 -0.054628128 -3.007692e-02
## 2015-02-27 -0.0089882099 0.0431362088 0.0614504237 0.056914695 5.468188e-02
## 2015-03-31 0.0037403503 -0.0150863626 -0.0143887144 0.010156542 -1.583041e-02
## 2015-04-30 -0.0032327766 0.0662817555 0.0358165040 -0.018417647 9.785963e-03
## 2015-05-29 -0.0043837179 -0.0419112626 0.0019525561 0.007509861 1.277434e-02
## 2015-06-30 -0.0108257854 -0.0297468860 -0.0316786893 0.004171207 -2.052106e-02
## 2015-07-31 0.0085847774 -0.0651779700 0.0201144971 -0.027375115 2.233758e-02
## 2015-08-31 -0.0033640618 -0.0925121983 -0.0771522561 -0.047268672 -6.288682e-02
## 2015-09-30 0.0080817155 -0.0318250291 -0.0451948417 -0.038464675 -2.584688e-02
## 2015-10-30 0.0006857283 0.0618082105 0.0640257338 0.063589771 8.163464e-02
## 2015-11-30 -0.0038983501 -0.0255602664 -0.0075556441 0.024415507 3.648768e-03
## 2015-12-31 -0.0019192693 -0.0389470612 -0.0235953923 -0.052157240 -1.743368e-02
## 2016-01-29 0.0123293832 -0.0516368460 -0.0567577107 -0.060306811 -5.106888e-02
## 2016-02-29 0.0088324070 -0.0082113829 -0.0339137399 0.020605214 -8.261511e-04
## 2016-03-31 0.0087085968 0.1218790103 0.0637456621 0.089910220 6.510018e-02
## 2016-04-29 0.0025471900 0.0040789675 0.0219751028 0.021044398 3.933690e-03
## 2016-05-31 0.0001349737 -0.0376282539 -0.0008560850 0.004397103 1.686859e-02
## 2016-06-30 0.0191666214 0.0445821471 -0.0244914364 0.008292322 3.469675e-03
## 2016-07-29 0.0054296807 0.0524421698 0.0390001498 0.049347989 3.582216e-02
## 2016-08-31 -0.0021564401 0.0087985353 0.0053269294 0.011261418 1.196565e-03
## 2016-09-30 0.0005161297 0.0248730444 0.0132789100 0.008614523 5.802547e-05
## 2016-10-31 -0.0082055412 -0.0083123267 -0.0224034967 -0.038134742 -1.748898e-02
## 2016-11-30 -0.0259893533 -0.0451617582 -0.0179747475 0.125246264 3.617616e-02
## 2016-12-30 0.0025383268 -0.0025301806 0.0267031619 0.031491932 2.006890e-02
## 2017-01-31 0.0021257664 0.0644317382 0.0323818267 -0.012144020 1.773648e-02
## 2017-02-28 0.0064381385 0.0172576525 0.0118365939 0.013428584 3.853933e-02
## 2017-03-31 -0.0005529492 0.0361892113 0.0318054298 -0.006532935 1.249196e-03
## 2017-04-28 0.0090288118 0.0168661758 0.0239523312 0.005107891 9.877228e-03
## 2017-05-31 0.0068472710 0.0280601262 0.0348100700 -0.022862804 1.401449e-02
## 2017-06-30 -0.0001821252 0.0092236596 0.0029560003 0.029151896 6.354504e-03
## 2017-07-31 0.0033344043 0.0565944241 0.0261880260 0.007481652 2.034559e-02
## 2017-08-31 0.0093689810 0.0232440232 -0.0004485755 -0.027564647 2.913498e-03
## 2017-09-29 -0.0057319150 -0.0004463619 0.0233430275 0.082321376 1.994907e-02
## 2017-10-31 0.0009780017 0.0322784976 0.0166537202 0.005916449 2.329088e-02
## 2017-11-30 -0.0014839719 -0.0038971178 0.0068699613 0.036913032 3.010795e-02
## 2017-12-29 0.0047396391 0.0369254231 0.0133982746 -0.003731078 1.205508e-02# Covariance of asset returns
covariance_matrix <- cov(asset_returns_wide_tbl)
covariance_matrix## AGG EEM EFA IJS SPY
## AGG 7.398248e-05 0.0001042128 4.178658e-05 -7.811334e-05 -9.028247e-06
## EEM 1.042128e-04 0.0017547104 1.039016e-03 6.437731e-04 6.795427e-04
## EFA 4.178658e-05 0.0010390158 1.064236e-03 6.490310e-04 6.975405e-04
## IJS -7.811334e-05 0.0006437731 6.490310e-04 1.565450e-03 8.290271e-04
## SPY -9.028247e-06 0.0006795427 6.975405e-04 8.290271e-04 7.408294e-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.0003874414 0.009257136 0.005815632 0.005684478 0.002330251rowSums(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")
# Custom function
calculate_component_contribution <- function(asset_returns_wide_tbl, w) {
# Covariance of asset returns
covariance_matrix <- cov(asset_returns_wide_tbl)
# Standard deviation of portfolio
sd_portfolio <- sqrt(t(w) %*% covariance_matrix %*% w)
# Component contribution
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(0.25,0.25,0.2,0.2,0.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
# Figure 10.1 Contribution to Standard Deviation ----
asset_returns_wide_tbl %>%
calculate_component_contribution(w = c(0.25,0.25,0.2,0.2,0.1)) %>%
gather(key = "asset", value = "contribution") %>%
ggplot(aes(asset, contribution)) +
geom_col(fill = "cornflowerblue") +
theme(plot.title = element_text(hjust = 0.5)) +
scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
labs(title = "Percent Contribution to Portfolio Standard Deviation",
y = "Percent Contribution to Risk",
x = NULL)
# Figure 10.2 Weight versus Contribution ----
asset_returns_wide_tbl %>%
calculate_component_contribution(w = c(0.25,0.25,0.2,0.2,0.1)) %>%
gather(key = "asset", value = "contribution") %>%
add_column(weights = c(0.25,0.25,0.2,0.2,0.1)) %>%
pivot_longer(cols = c(contribution, weights), names_to = "type", values_to = "value") %>%
ggplot(aes(asset, value, fill = type)) +
geom_col(position = "dodge") +
theme(plot.title = element_text(hjust = 0.5)) +
scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
theme_tq() +
scale_fill_tq() +
labs(title = "Percent Contribution to Portfolio Volatility and weight",
y = "percent",
x = "asset") 