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.0062307459 -0.0029354630 0.0366064890 0.052133088 4.992303e-02
## 2013-02-28 0.0058910242 -0.0231053436 -0.0129695687 0.016175614 1.267864e-02
## 2013-03-28 0.0009852750 -0.0102347821 0.0129695687 0.040257517 3.726744e-02
## 2013-04-30 0.0096390249 0.0120845624 0.0489674545 0.001223085 1.903053e-02
## 2013-05-31 -0.0202138937 -0.0494836146 -0.0306553350 0.041976039 2.333516e-02
## 2013-06-28 -0.0157786974 -0.0547281476 -0.0271444699 -0.001402714 -1.343458e-02
## 2013-07-31 0.0026885094 0.0131596987 0.0518601691 0.063541204 5.038614e-02
## 2013-08-30 -0.0082989401 -0.0257054850 -0.0197462899 -0.034743429 -3.045121e-02
## 2013-09-30 0.0111439869 0.0695889506 0.0753384226 0.063873590 3.115589e-02
## 2013-10-31 0.0082923147 0.0408612874 0.0320818005 0.034233982 4.526678e-02
## 2013-11-29 -0.0025099204 -0.0025944828 0.0054495429 0.041661294 2.920669e-02
## 2013-12-31 -0.0055830389 -0.0040742478 0.0215282903 0.012892297 2.559610e-02
## 2014-01-31 0.0152919079 -0.0903225597 -0.0534135434 -0.035775298 -3.588423e-02
## 2014-02-28 0.0037564657 0.0332205386 0.0595050946 0.045257092 4.451030e-02
## 2014-03-31 -0.0014813797 0.0380220512 -0.0046025669 0.013315432 8.261134e-03
## 2014-04-30 0.0081824288 0.0077723927 0.0165295240 -0.023184120 6.927760e-03
## 2014-05-30 0.0117222359 0.0290914162 0.0158284987 0.006205060 2.294094e-02
## 2014-06-30 -0.0005755526 0.0237333895 0.0091651842 0.037718728 2.043468e-02
## 2014-07-31 -0.0025126307 0.0135557940 -0.0263796313 -0.052009348 -1.352891e-02
## 2014-08-29 0.0114311218 0.0279046866 0.0018004225 0.043658014 3.870482e-02
## 2014-09-30 -0.0061671142 -0.0808568050 -0.0395985696 -0.061260582 -1.389215e-02
## 2014-10-31 0.0105849710 0.0140965675 -0.0026547319 0.068874970 2.327788e-02
## 2014-11-28 0.0065483196 -0.0155412980 0.0006252305 0.004773570 2.710152e-02
## 2014-12-31 0.0014748834 -0.0404418739 -0.0407466482 0.025295815 -2.540313e-03
## 2015-01-30 0.0203154235 -0.0068962146 0.0062265045 -0.054628178 -3.007673e-02
## 2015-02-27 -0.0089881472 0.0431364934 0.0614504579 0.056914720 5.468167e-02
## 2015-03-31 0.0037399503 -0.0150863669 -0.0143887072 0.010156453 -1.583005e-02
## 2015-04-30 -0.0032328216 0.0662815240 0.0358166578 -0.018417676 9.785733e-03
## 2015-05-29 -0.0043835519 -0.0419113520 0.0019524970 0.007509879 1.277412e-02
## 2015-06-30 -0.0108255936 -0.0297462660 -0.0316787522 0.004171383 -2.052110e-02
## 2015-07-31 0.0085847430 -0.0651783054 0.0201146365 -0.027375427 2.233820e-02
## 2015-08-31 -0.0033639904 -0.0925124042 -0.0771524800 -0.047268345 -6.288708e-02
## 2015-09-30 0.0080815184 -0.0318249231 -0.0451949791 -0.038464628 -2.584717e-02
## 2015-10-30 0.0006857815 0.0618083705 0.0640257303 0.063589718 8.163528e-02
## 2015-11-30 -0.0038983288 -0.0255604013 -0.0075556372 0.024415461 3.648476e-03
## 2015-12-31 -0.0019193720 -0.0389470993 -0.0235949460 -0.052157180 -1.743364e-02
## 2016-01-29 0.0123300171 -0.0516368216 -0.0567578149 -0.060306852 -5.106861e-02
## 2016-02-29 0.0088319193 -0.0082115302 -0.0339140811 0.020605059 -8.266974e-04
## 2016-03-31 0.0087085116 0.1218790519 0.0637455223 0.089910505 6.510044e-02
## 2016-04-29 0.0025461615 0.0040793489 0.0219753557 0.021044294 3.933495e-03
## 2016-05-31 0.0001357955 -0.0376287098 -0.0008561299 0.004397248 1.686878e-02
## 2016-06-30 0.0191666290 0.0445823386 -0.0244914523 0.008291892 3.469566e-03
## 2016-07-29 0.0054296552 0.0524422848 0.0390003623 0.049348325 3.582198e-02
## 2016-08-31 -0.0021560214 0.0087983513 0.0053266973 0.011261356 1.196862e-03
## 2016-09-30 0.0005157031 0.0248727566 0.0132792398 0.008614580 5.803865e-05
## 2016-10-31 -0.0082049640 -0.0083120099 -0.0224038311 -0.038134891 -1.748916e-02
## 2016-11-30 -0.0259898089 -0.0451618381 -0.0179743989 0.125246670 3.617597e-02
## 2016-12-30 0.0025378123 -0.0025300744 0.0267029429 0.031491411 2.006897e-02
## 2017-01-31 0.0021264331 0.0644315875 0.0323818741 -0.012143723 1.773672e-02
## 2017-02-28 0.0064375851 0.0172580751 0.0118363126 0.013428792 3.853916e-02
## 2017-03-31 -0.0005524821 0.0361887500 0.0318057896 -0.006532952 1.249290e-03
## 2017-04-28 0.0090287253 0.0168663993 0.0239520652 0.005107724 9.877149e-03
## 2017-05-31 0.0068476057 0.0280597687 0.0348103340 -0.022863131 1.401429e-02
## 2017-06-30 -0.0001826835 0.0092240905 0.0029559265 0.029151895 6.354682e-03
## 2017-07-31 0.0033347155 0.0565942299 0.0261880077 0.007481503 2.034592e-02
## 2017-08-31 0.0093691917 0.0232439755 -0.0004484332 -0.027564414 2.913352e-03
## 2017-09-29 -0.0057322348 -0.0004462957 0.0233427068 0.082321627 1.994893e-02
## 2017-10-31 0.0009777967 0.0322785714 0.0166538659 0.005916156 2.329090e-02
## 2017-11-30 -0.0014839347 -0.0038971458 0.0068699041 0.036913231 3.010810e-02
## 2017-12-29 0.0047402032 0.0369256799 0.0133983361 -0.003731086 1.205481e-02# Covariance of asset returns
covariance_matrix <- cov(asset_returns_wide_tbl)
covariance_matrix## AGG EEM EFA IJS SPY
## AGG 7.398455e-05 0.0001042112 4.178389e-05 -7.811793e-05 -9.028675e-06
## EEM 1.042112e-04 0.0017547132 1.039017e-03 6.437743e-04 6.795439e-04
## EFA 4.178389e-05 0.0010390167 1.064237e-03 6.490293e-04 6.975425e-04
## IJS -7.811793e-05 0.0006437743 6.490293e-04 1.565450e-03 8.290236e-04
## SPY -9.028675e-06 0.0006795439 6.975425e-04 8.290236e-04 7.408300e-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.02347493# 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.0003874269 0.00925715 0.005815632 0.005684467 0.002330252rowSums(component_contribution)## [1] 0.02347493# 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.096
## 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."))