Week 14: Code along 12
CHAPTER 10 Component Contribution to Standard Deviation
Ty Bacci
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.0062309953 -0.0029354859 0.0366060287 0.052132987 4.992291e-02
## 2013-02-28 0.0058906695 -0.0231053479 -0.0129691922 0.016175774 1.267868e-02
## 2013-03-28 0.0009848159 -0.0102346459 0.0129691922 0.040257568 3.726720e-02
## 2013-04-30 0.0096393866 0.0120845418 0.0489678087 0.001223052 1.903041e-02
## 2013-05-31 -0.0202143735 -0.0494831579 -0.0306555009 0.041976283 2.333549e-02
## 2013-06-28 -0.0157783320 -0.0547284557 -0.0271445280 -0.001403100 -1.343408e-02
## 2013-07-31 0.0026878030 0.0131596683 0.0518604853 0.063541144 5.038571e-02
## 2013-08-30 -0.0082978803 -0.0257057691 -0.0197464212 -0.034743101 -3.045157e-02
## 2013-09-30 0.0111435409 0.0695888981 0.0753386042 0.063873430 3.115660e-02
## 2013-10-31 0.0082921946 0.0408612364 0.0320815724 0.034234341 4.526607e-02
## 2013-11-29 -0.0025093269 -0.0025940761 0.0054495999 0.041660819 2.920701e-02
## 2013-12-31 -0.0055832364 -0.0040743565 0.0215279293 0.012892297 2.559667e-02
## 2014-01-31 0.0152914915 -0.0903225366 -0.0534131084 -0.035775308 -3.588464e-02
## 2014-02-28 0.0037564569 0.0332204819 0.0595050030 0.045257425 4.450994e-02
## 2014-03-31 -0.0014812665 0.0380217584 -0.0046025730 0.013314989 8.261301e-03
## 2014-04-30 0.0081828782 0.0077726729 0.0165292653 -0.023184112 6.927556e-03
## 2014-05-30 0.0117224101 0.0290910768 0.0158286779 0.006205532 2.294165e-02
## 2014-06-30 -0.0005761241 0.0237340576 0.0091652618 0.037718490 2.043435e-02
## 2014-07-31 -0.0025120605 0.0135555761 -0.0263797347 -0.052009337 -1.352850e-02
## 2014-08-29 0.0114306220 0.0279043913 0.0018004766 0.043657863 3.870449e-02
## 2014-09-30 -0.0061669754 -0.0808563287 -0.0395986182 -0.061260479 -1.389227e-02
## 2014-10-31 0.0105842670 0.0140962229 -0.0026547701 0.068874805 2.327780e-02
## 2014-11-28 0.0065485235 -0.0155412100 0.0006252476 0.004773573 2.710132e-02
## 2014-12-31 0.0014754357 -0.0404419346 -0.0407464770 0.025295758 -2.539647e-03
## 2015-01-30 0.0203151709 -0.0068960029 0.0062261958 -0.054627813 -3.007710e-02
## 2015-02-27 -0.0089884833 0.0431361473 0.0614509116 0.056914610 5.468196e-02
## 2015-03-31 0.0037404419 -0.0150862429 -0.0143890329 0.010156466 -1.583014e-02
## 2015-04-30 -0.0032331431 0.0662814118 0.0358165820 -0.018417570 9.785784e-03
## 2015-05-29 -0.0043838115 -0.0419110386 0.0019526337 0.007509707 1.277399e-02
## 2015-06-30 -0.0108252322 -0.0297465852 -0.0316788449 0.004171284 -2.052097e-02
## 2015-07-31 0.0085846844 -0.0651781424 0.0201145758 -0.027375272 2.233758e-02
## 2015-08-31 -0.0033637841 -0.0925123972 -0.0771524198 -0.047268597 -6.288664e-02
## 2015-09-30 0.0080818051 -0.0318248132 -0.0451947567 -0.038464678 -2.584697e-02
## 2015-10-30 0.0006847189 0.0618080651 0.0640258172 0.063589936 8.163463e-02
## 2015-11-30 -0.0038978000 -0.0255603366 -0.0075558116 0.024415193 3.648595e-03
## 2015-12-31 -0.0019192695 -0.0389470640 -0.0235951360 -0.052157006 -1.743341e-02
## 2016-01-29 0.0123303870 -0.0516366963 -0.0567577917 -0.060306898 -5.106832e-02
## 2016-02-29 0.0088315859 -0.0082116920 -0.0339140194 0.020605472 -8.268924e-04
## 2016-03-31 0.0087087752 0.1218792426 0.0637458506 0.089910362 6.510026e-02
## 2016-04-29 0.0025459387 0.0040788992 0.0219751893 0.021044162 3.933689e-03
## 2016-05-31 0.0001358671 -0.0376282565 -0.0008562580 0.004397027 1.686842e-02
## 2016-06-30 0.0191664478 0.0445822857 -0.0244914386 0.008292020 3.469676e-03
## 2016-07-29 0.0054295078 0.0524422306 0.0390003238 0.049348579 3.582208e-02
## 2016-08-31 -0.0021561790 0.0087985342 0.0053266743 0.011261130 1.196811e-03
## 2016-09-30 0.0005160425 0.0248727925 0.0132791635 0.008614382 5.786201e-05
## 2016-10-31 -0.0082046632 -0.0083118887 -0.0224036661 -0.038134674 -1.748881e-02
## 2016-11-30 -0.0259899694 -0.0451619406 -0.0179744003 0.125246337 3.617599e-02
## 2016-12-30 0.0025378763 -0.0025301145 0.0267029003 0.031491932 2.006890e-02
## 2017-01-31 0.0021261270 0.0644314792 0.0323817445 -0.012143893 1.773672e-02
## 2017-02-28 0.0064380497 0.0172577748 0.0118365136 0.013428395 3.853940e-02
## 2017-03-31 -0.0005526811 0.0361890338 0.0318057497 -0.006532683 1.248825e-03
## 2017-04-28 0.0090288995 0.0168664077 0.0239521738 0.005107827 9.877377e-03
## 2017-05-31 0.0068470938 0.0280598995 0.0348102184 -0.022862993 1.401413e-02
## 2017-06-30 -0.0001822132 0.0092237714 0.0029558519 0.029152396 6.355011e-03
## 2017-07-31 0.0033341415 0.0565945288 0.0261879539 0.007481340 2.034558e-02
## 2017-08-31 0.0093694187 0.0232438163 -0.0004483592 -0.027564897 2.913498e-03
## 2017-09-29 -0.0057325262 -0.0004464642 0.0233428833 0.082321854 1.994907e-02
## 2017-10-31 0.0009781768 0.0322786031 0.0166535816 0.005915865 2.329054e-02
## 2017-11-30 -0.0014837101 -0.0038969193 0.0068699622 0.036913377 3.010822e-02
## 2017-12-29 0.0047399875 0.0369255154 0.0133983443 -0.003731303 1.205495e-02# Covariance of asset returns
covariance_matrix <- cov(asset_returns_wide_tbl)
covariance_matrix## AGG EEM EFA IJS SPY
## AGG 7.398373e-05 0.0001042068 4.177928e-05 -7.812354e-05 -9.034215e-06
## EEM 1.042068e-04 0.0017547089 1.039016e-03 6.437728e-04 6.795419e-04
## EFA 4.177928e-05 0.0010390164 1.064238e-03 6.490312e-04 6.975399e-04
## IJS -7.812354e-05 0.0006437728 6.490312e-04 1.565448e-03 8.290228e-04
## SPY -9.034215e-06 0.0006795419 6.975399e-04 8.290228e-04 7.408253e-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.02347487# 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.0003873862 0.009257142 0.005815637 0.005684464 0.002330245rowSums(component_contribution)## [1] 0.02347487# 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 Volatility",
y = "percent",
x = "asset") 
6 Rolling Component Contribution
calculate_comp_contrib_by_window <- function(asset_returns_wide_tbl,
start = 1,
window = 24,
weights) {
# 1 Define start date
start_date <- rownames(asset_returns_wide_tbl)[start]
# 2 Define end date
end_date <- rownames(asset_returns_wide_tbl)[start + window]
# 3 Subset df
df_subset <- asset_returns_wide_tbl %>%
rownames_to_column(var = "date") %>%
filter(date >= start_date & date < end_date) %>%
column_to_rownames(var = "date")
# 4 Calculate component contribution
component_percentages <-df_subset %>%
calculate_component_contribution(w = weights)
# 5 Add end date to df
component_percentages %>%
mutate(date = ymd(end_date)) %>%
select(date, everything())
}
# Check the custom function
asset_returns_wide_tbl %>% calculate_comp_contrib_by_window(start = 1, window = 24,
w = c(0.25,0.25,0.2,0.2,0.1))## # A tibble: 1 × 6
## date AGG EEM EFA IJS SPY
## <date> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 2015-01-30 0.039 0.372 0.256 0.245 0.088asset_returns_wide_tbl %>% calculate_comp_contrib_by_window(start = 2, window = 24,
w = c(0.25,0.25,0.2,0.2,0.1))## # A tibble: 1 × 6
## date AGG EEM EFA IJS SPY
## <date> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 2015-02-27 0.036 0.374 0.249 0.252 0.089dump(list = c("calculate_component_contribution",
"calculate_comp_contrib_by_window"),
file = "../00_scripts/calculate_comp_contrib_to_portfolio_volatility.R")# Iterate the custom function
w <- c(0.25,0.25,0.2,0.2,0.1)
window <- 24
rolling_comp_contrib_tbl <- 1:(nrow(asset_returns_wide_tbl) - window) %>%
map_df(.x = ., .f = ~calculate_comp_contrib_by_window(asset_returns_wide_tbl,
start = .x,
weights = w,
window = window))
rolling_comp_contrib_tbl## # A tibble: 36 × 6
## date AGG EEM EFA IJS SPY
## <date> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 2015-01-30 0.039 0.372 0.256 0.245 0.088
## 2 2015-02-27 0.036 0.374 0.249 0.252 0.089
## 3 2015-03-31 0.027 0.37 0.255 0.255 0.092
## 4 2015-04-30 0.027 0.372 0.256 0.252 0.093
## 5 2015-05-29 0.024 0.385 0.254 0.246 0.092
## 6 2015-06-30 0.018 0.383 0.248 0.257 0.094
## 7 2015-07-31 0.014 0.375 0.253 0.261 0.097
## 8 2015-08-31 0.013 0.404 0.237 0.257 0.09
## 9 2015-09-30 0.012 0.407 0.248 0.238 0.094
## 10 2015-10-30 0.003 0.405 0.244 0.243 0.105
## # ℹ 26 more rows# Figure 10.3 Component Contribution ggplot ----
rolling_comp_contrib_tbl %>%
# Transform data to long form
pivot_longer(cols = -date, names_to = "asset", values_to = "contribution") %>%
# Plot
ggplot(aes(date, contribution, color = asset)) +
geom_line() +
scale_x_date(breaks = scales::pretty_breaks(n = 7)) +
scale_y_continuous(labels = scales::percent_format()) +
annotate(geom = "text",
x = as.Date("2016-07-01"),
y = 0.03,
color = "red", size = 5,
label = str_glue("AGG dips below zero sometimes, indicating
it reduces the portfolio volatility."))
# Figure 10.4 Stacked Component Contribution ggplot ----
rolling_comp_contrib_tbl %>%
# Transform data to long form
pivot_longer(cols = -date, names_to = "asset", values_to = "contribution") %>%
# Plot
ggplot(aes(date, contribution, fill = asset)) +
geom_area() +
scale_x_date(breaks = scales::pretty_breaks(n = 7)) +
scale_y_continuous(labels = scales::percent_format()) +
annotate(geom = "text",
x = as.Date("2016-07-01"),
y = 0.08,
color = "red", size = 5,
label = str_glue("AGG dips below zero sometimes, indicating
it reduces the portfolio volatility."))