Week 13: Code along 12
CHAPTER 10 Component Contribution to Standard Deviation
Ashley Loureiro
2023-04-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.0062316915 -0.0029355127 0.0366064580 0.052133571 4.992329e-02
## 2013-02-28 0.0058912534 -0.0231051733 -0.0129693233 0.016175286 1.267832e-02
## 2013-03-28 0.0009854894 -0.0102349970 0.0129693233 0.040257846 3.726800e-02
## 2013-04-30 0.0096387035 0.0120845677 0.0489679329 0.001222579 1.902985e-02
## 2013-05-31 -0.0202144656 -0.0494832234 -0.0306554762 0.041976419 2.333541e-02
## 2013-06-28 -0.0157775348 -0.0547284477 -0.0271448166 -0.001402992 -1.343454e-02
## 2013-07-31 0.0026869129 0.0131601575 0.0518604624 0.063541581 5.038571e-02
## 2013-08-30 -0.0082975112 -0.0257060285 -0.0197461429 -0.034743645 -3.045078e-02
## 2013-09-30 0.0111438309 0.0695887933 0.0753382634 0.063873526 3.115605e-02
## 2013-10-31 0.0082923618 0.0408611695 0.0320818492 0.034234160 4.526625e-02
## 2013-11-29 -0.0025101456 -0.0025939582 0.0054495590 0.041661273 2.920737e-02
## 2013-12-31 -0.0055833468 -0.0040743008 0.0215280708 0.012892060 2.559581e-02
## 2014-01-31 0.0152917047 -0.0903225241 -0.0534135041 -0.035775292 -3.588474e-02
## 2014-02-28 0.0037568560 0.0332207988 0.0595052570 0.045257338 4.451051e-02
## 2014-03-31 -0.0014811462 0.0380213745 -0.0046026799 0.013315156 8.261502e-03
## 2014-04-30 0.0081829373 0.0077729133 0.0165294973 -0.023183889 6.927274e-03
## 2014-05-30 0.0117217327 0.0290910706 0.0158283517 0.006204807 2.294099e-02
## 2014-06-30 -0.0005755532 0.0237339251 0.0091654347 0.037718894 2.043510e-02
## 2014-07-31 -0.0025119911 0.0135553808 -0.0263797850 -0.052009549 -1.352878e-02
## 2014-08-29 0.0114302400 0.0279045779 0.0018003039 0.043658275 3.870454e-02
## 2014-09-30 -0.0061671538 -0.0808563596 -0.0395983254 -0.061260605 -1.389209e-02
## 2014-10-31 0.0105844305 0.0140961089 -0.0026546340 0.068874609 2.327806e-02
## 2014-11-28 0.0065488404 -0.0155409761 0.0006251561 0.004773782 2.710112e-02
## 2014-12-31 0.0014751233 -0.0404424506 -0.0407468320 0.025295767 -2.539592e-03
## 2015-01-30 0.0203154293 -0.0068956277 0.0062265036 -0.054627765 -3.007729e-02
## 2015-02-27 -0.0089884999 0.0431363722 0.0614506078 0.056914518 5.468203e-02
## 2015-03-31 0.0037406569 -0.0150863546 -0.0143887705 0.010156398 -1.583038e-02
## 2015-04-30 -0.0032332325 0.0662814792 0.0358165769 -0.018417676 9.785555e-03
## 2015-05-29 -0.0043839967 -0.0419110057 0.0019527483 0.007509875 1.277442e-02
## 2015-06-30 -0.0108253022 -0.0297467732 -0.0316789392 0.004171395 -2.052108e-02
## 2015-07-31 0.0085848127 -0.0651781389 0.0201145127 -0.027375473 2.233773e-02
## 2015-08-31 -0.0033639476 -0.0925123523 -0.0771523775 -0.047268398 -6.288678e-02
## 2015-09-30 0.0080814243 -0.0318250033 -0.0451948664 -0.038464765 -2.584693e-02
## 2015-10-30 0.0006853393 0.0618082047 0.0640259447 0.063590061 8.163512e-02
## 2015-11-30 -0.0038981243 -0.0255605363 -0.0075559415 0.024415109 3.648255e-03
## 2015-12-31 -0.0019186568 -0.0389468732 -0.0235949725 -0.052157030 -1.743337e-02
## 2016-01-29 0.0123298737 -0.0516368333 -0.0567578101 -0.060306765 -5.106897e-02
## 2016-02-29 0.0088315209 -0.0082113863 -0.0339140718 0.020605043 -8.261809e-04
## 2016-03-31 0.0087088859 0.1218790003 0.0637457685 0.089910297 6.510035e-02
## 2016-04-29 0.0025461088 0.0040790876 0.0219750380 0.021044271 3.933364e-03
## 2016-05-31 0.0001354527 -0.0376283948 -0.0008561218 0.004397040 1.686872e-02
## 2016-06-30 0.0191668117 0.0445824647 -0.0244914111 0.008292174 3.469721e-03
## 2016-07-29 0.0054295451 0.0524420817 0.0390002822 0.049348583 3.582187e-02
## 2016-08-31 -0.0021565143 0.0087984104 0.0053267594 0.011261014 1.196558e-03
## 2016-09-30 0.0005163969 0.0248730027 0.0132791871 0.008614747 5.829312e-05
## 2016-10-31 -0.0082054082 -0.0083120135 -0.0224037254 -0.038134761 -1.748910e-02
## 2016-11-30 -0.0259896590 -0.0451619697 -0.0179744481 0.125246160 3.617619e-02
## 2016-12-30 0.0025379519 -0.0025302216 0.0267028900 0.031491750 2.006893e-02
## 2017-01-31 0.0021261271 0.0644316093 0.0323819384 -0.012143672 1.773643e-02
## 2017-02-28 0.0064378359 0.0172580111 0.0118363811 0.013428814 3.853940e-02
## 2017-03-31 -0.0005526367 0.0361887595 0.0318057513 -0.006533323 1.249130e-03
## 2017-04-28 0.0090294567 0.0168665974 0.0239522341 0.005108072 9.877109e-03
## 2017-05-31 0.0068472444 0.0280598750 0.0348101251 -0.022862623 1.401419e-02
## 2017-06-30 -0.0001822625 0.0092237211 0.0029559942 0.029151467 6.354992e-03
## 2017-07-31 0.0033337495 0.0565941774 0.0261879682 0.007481917 2.034557e-02
## 2017-08-31 0.0093694559 0.0232441929 -0.0004481568 -0.027564865 2.913471e-03
## 2017-09-29 -0.0057322001 -0.0004463554 0.0233426474 0.082321402 1.994918e-02
## 2017-10-31 0.0009778874 0.0322785843 0.0166535035 0.005916325 2.329065e-02
## 2017-11-30 -0.0014841321 -0.0038971225 0.0068701369 0.036913295 3.010817e-02
## 2017-12-29 0.0047403691 0.0369254136 0.0133982350 -0.003731106 1.205508e-02# Covariance of asset returns
covariance_matrix <- cov(asset_returns_wide_tbl)
covariance_matrix## AGG EEM EFA IJS SPY
## AGG 7.398378e-05 0.0001042083 4.177982e-05 -7.812249e-05 -9.034658e-06
## EEM 1.042083e-04 0.0017547097 1.039018e-03 6.437739e-04 6.795430e-04
## EFA 4.177982e-05 0.0010390178 1.064239e-03 6.490309e-04 6.975406e-04
## IJS -7.812249e-05 0.0006437739 6.490309e-04 1.565449e-03 8.290276e-04
## SPY -9.034658e-06 0.0006795430 6.975406e-04 8.290276e-04 7.408298e-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.02347489# 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.0003873927 0.009257146 0.005815637 0.005684469 0.00233025rowSums(component_contribution)## [1] 0.02347489# 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.0062316915 -0.0029355127 0.0366064580 0.052133571 4.992329e-02
## 2013-02-28 0.0058912534 -0.0231051733 -0.0129693233 0.016175286 1.267832e-02
## 2013-03-28 0.0009854894 -0.0102349970 0.0129693233 0.040257846 3.726800e-02
## 2013-04-30 0.0096387035 0.0120845677 0.0489679329 0.001222579 1.902985e-02
## 2013-05-31 -0.0202144656 -0.0494832234 -0.0306554762 0.041976419 2.333541e-02
## 2013-06-28 -0.0157775348 -0.0547284477 -0.0271448166 -0.001402992 -1.343454e-02
## 2013-07-31 0.0026869129 0.0131601575 0.0518604624 0.063541581 5.038571e-02
## 2013-08-30 -0.0082975112 -0.0257060285 -0.0197461429 -0.034743645 -3.045078e-02
## 2013-09-30 0.0111438309 0.0695887933 0.0753382634 0.063873526 3.115605e-02
## 2013-10-31 0.0082923618 0.0408611695 0.0320818492 0.034234160 4.526625e-02
## 2013-11-29 -0.0025101456 -0.0025939582 0.0054495590 0.041661273 2.920737e-02
## 2013-12-31 -0.0055833468 -0.0040743008 0.0215280708 0.012892060 2.559581e-02
## 2014-01-31 0.0152917047 -0.0903225241 -0.0534135041 -0.035775292 -3.588474e-02
## 2014-02-28 0.0037568560 0.0332207988 0.0595052570 0.045257338 4.451051e-02
## 2014-03-31 -0.0014811462 0.0380213745 -0.0046026799 0.013315156 8.261502e-03
## 2014-04-30 0.0081829373 0.0077729133 0.0165294973 -0.023183889 6.927274e-03
## 2014-05-30 0.0117217327 0.0290910706 0.0158283517 0.006204807 2.294099e-02
## 2014-06-30 -0.0005755532 0.0237339251 0.0091654347 0.037718894 2.043510e-02
## 2014-07-31 -0.0025119911 0.0135553808 -0.0263797850 -0.052009549 -1.352878e-02
## 2014-08-29 0.0114302400 0.0279045779 0.0018003039 0.043658275 3.870454e-02
## 2014-09-30 -0.0061671538 -0.0808563596 -0.0395983254 -0.061260605 -1.389209e-02
## 2014-10-31 0.0105844305 0.0140961089 -0.0026546340 0.068874609 2.327806e-02
## 2014-11-28 0.0065488404 -0.0155409761 0.0006251561 0.004773782 2.710112e-02
## 2014-12-31 0.0014751233 -0.0404424506 -0.0407468320 0.025295767 -2.539592e-03
## 2015-01-30 0.0203154293 -0.0068956277 0.0062265036 -0.054627765 -3.007729e-02
## 2015-02-27 -0.0089884999 0.0431363722 0.0614506078 0.056914518 5.468203e-02
## 2015-03-31 0.0037406569 -0.0150863546 -0.0143887705 0.010156398 -1.583038e-02
## 2015-04-30 -0.0032332325 0.0662814792 0.0358165769 -0.018417676 9.785555e-03
## 2015-05-29 -0.0043839967 -0.0419110057 0.0019527483 0.007509875 1.277442e-02
## 2015-06-30 -0.0108253022 -0.0297467732 -0.0316789392 0.004171395 -2.052108e-02
## 2015-07-31 0.0085848127 -0.0651781389 0.0201145127 -0.027375473 2.233773e-02
## 2015-08-31 -0.0033639476 -0.0925123523 -0.0771523775 -0.047268398 -6.288678e-02
## 2015-09-30 0.0080814243 -0.0318250033 -0.0451948664 -0.038464765 -2.584693e-02
## 2015-10-30 0.0006853393 0.0618082047 0.0640259447 0.063590061 8.163512e-02
## 2015-11-30 -0.0038981243 -0.0255605363 -0.0075559415 0.024415109 3.648255e-03
## 2015-12-31 -0.0019186568 -0.0389468732 -0.0235949725 -0.052157030 -1.743337e-02
## 2016-01-29 0.0123298737 -0.0516368333 -0.0567578101 -0.060306765 -5.106897e-02
## 2016-02-29 0.0088315209 -0.0082113863 -0.0339140718 0.020605043 -8.261809e-04
## 2016-03-31 0.0087088859 0.1218790003 0.0637457685 0.089910297 6.510035e-02
## 2016-04-29 0.0025461088 0.0040790876 0.0219750380 0.021044271 3.933364e-03
## 2016-05-31 0.0001354527 -0.0376283948 -0.0008561218 0.004397040 1.686872e-02
## 2016-06-30 0.0191668117 0.0445824647 -0.0244914111 0.008292174 3.469721e-03
## 2016-07-29 0.0054295451 0.0524420817 0.0390002822 0.049348583 3.582187e-02
## 2016-08-31 -0.0021565143 0.0087984104 0.0053267594 0.011261014 1.196558e-03
## 2016-09-30 0.0005163969 0.0248730027 0.0132791871 0.008614747 5.829312e-05
## 2016-10-31 -0.0082054082 -0.0083120135 -0.0224037254 -0.038134761 -1.748910e-02
## 2016-11-30 -0.0259896590 -0.0451619697 -0.0179744481 0.125246160 3.617619e-02
## 2016-12-30 0.0025379519 -0.0025302216 0.0267028900 0.031491750 2.006893e-02
## 2017-01-31 0.0021261271 0.0644316093 0.0323819384 -0.012143672 1.773643e-02
## 2017-02-28 0.0064378359 0.0172580111 0.0118363811 0.013428814 3.853940e-02
## 2017-03-31 -0.0005526367 0.0361887595 0.0318057513 -0.006533323 1.249130e-03
## 2017-04-28 0.0090294567 0.0168665974 0.0239522341 0.005108072 9.877109e-03
## 2017-05-31 0.0068472444 0.0280598750 0.0348101251 -0.022862623 1.401419e-02
## 2017-06-30 -0.0001822625 0.0092237211 0.0029559942 0.029151467 6.354992e-03
## 2017-07-31 0.0033337495 0.0565941774 0.0261879682 0.007481917 2.034557e-02
## 2017-08-31 0.0093694559 0.0232441929 -0.0004481568 -0.027564865 2.913471e-03
## 2017-09-29 -0.0057322001 -0.0004463554 0.0233426474 0.082321402 1.994918e-02
## 2017-10-31 0.0009778874 0.0322785843 0.0166535035 0.005916325 2.329065e-02
## 2017-11-30 -0.0014841321 -0.0038971225 0.0068701369 0.036913295 3.010817e-02
## 2017-12-29 0.0047403691 0.0369254136 0.0133982350 -0.003731106 1.205508e-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")
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)