Week 14: Code along 12
CHAPTER 10 Component Contribution to Standard Deviation
Tyler Kayo
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.0062311753 -0.0029354841 0.0366064478 0.052133476 4.992261e-02
## 2013-02-28 0.0058912346 -0.0231055201 -0.0129696694 0.016175319 1.267831e-02
## 2013-03-28 0.0009849994 -0.0102350379 0.0129696694 0.040258336 3.726812e-02
## 2013-04-30 0.0096393165 0.0120848714 0.0489677331 0.001221917 1.903029e-02
## 2013-05-31 -0.0202143132 -0.0494832470 -0.0306555723 0.041976532 2.333506e-02
## 2013-06-28 -0.0157779818 -0.0547282986 -0.0271444699 -0.001402890 -1.343394e-02
## 2013-07-31 0.0026878782 0.0131596068 0.0518601944 0.063541012 5.038561e-02
## 2013-08-30 -0.0082980387 -0.0257054581 -0.0197463287 -0.034743171 -3.045106e-02
## 2013-09-30 0.0111432151 0.0695887396 0.0753385173 0.063873387 3.115566e-02
## 2013-10-31 0.0082922475 0.0408610462 0.0320818277 0.034234476 4.526638e-02
## 2013-11-29 -0.0025098794 -0.0025939880 0.0054496043 0.041661092 2.920735e-02
## 2013-12-31 -0.0055830616 -0.0040741678 0.0215280253 0.012892252 2.559617e-02
## 2014-01-31 0.0152919117 -0.0903224452 -0.0534133163 -0.035775278 -3.588472e-02
## 2014-02-28 0.0037567610 0.0332203232 0.0595051246 0.045257345 4.451045e-02
## 2014-03-31 -0.0014818965 0.0380217395 -0.0046026585 0.013315014 8.261281e-03
## 2014-04-30 0.0081835274 0.0077728675 0.0165293759 -0.023184273 6.927492e-03
## 2014-05-30 0.0117209376 0.0290908548 0.0158282324 0.006205572 2.294116e-02
## 2014-06-30 -0.0005749806 0.0237339757 0.0091655973 0.037718736 2.043482e-02
## 2014-07-31 -0.0025123686 0.0135558042 -0.0263795824 -0.052009486 -1.352884e-02
## 2014-08-29 0.0114310294 0.0279045008 0.0018002621 0.043657937 3.870474e-02
## 2014-09-30 -0.0061673343 -0.0808566524 -0.0395983871 -0.061260437 -1.389231e-02
## 2014-10-31 0.0105841894 0.0140965813 -0.0026547524 0.068874579 2.327767e-02
## 2014-11-28 0.0065491454 -0.0155414175 0.0006250736 0.004773962 2.710140e-02
## 2014-12-31 0.0014750586 -0.0404421868 -0.0407465766 0.025295704 -2.539622e-03
## 2015-01-30 0.0203150371 -0.0068956229 0.0062263686 -0.054627952 -3.007684e-02
## 2015-02-27 -0.0089881695 0.0431359184 0.0614506437 0.056914620 5.468141e-02
## 2015-03-31 0.0037403241 -0.0150862344 -0.0143887809 0.010156422 -1.583014e-02
## 2015-04-30 -0.0032328335 0.0662814221 0.0358166738 -0.018417837 9.786096e-03
## 2015-05-29 -0.0043838332 -0.0419110980 0.0019524833 0.007509873 1.277413e-02
## 2015-06-30 -0.0108253644 -0.0297462661 -0.0316788973 0.004171328 -2.052116e-02
## 2015-07-31 0.0085844389 -0.0651784670 0.0201146780 -0.027375187 2.233778e-02
## 2015-08-31 -0.0033639886 -0.0925123720 -0.0771525052 -0.047268272 -6.288674e-02
## 2015-09-30 0.0080818303 -0.0318248313 -0.0451949278 -0.038465001 -2.584712e-02
## 2015-10-30 0.0006853663 0.0618083342 0.0640261035 0.063589922 8.163506e-02
## 2015-11-30 -0.0038982201 -0.0255603443 -0.0075560265 0.024415157 3.648443e-03
## 2015-12-31 -0.0019189459 -0.0389473005 -0.0235950341 -0.052157051 -1.743350e-02
## 2016-01-29 0.0123294527 -0.0516365772 -0.0567578138 -0.060307025 -5.106882e-02
## 2016-02-29 0.0088321572 -0.0082115852 -0.0339139975 0.020605402 -8.262119e-04
## 2016-03-31 0.0087086832 0.1218788723 0.0637457067 0.089910366 6.510028e-02
## 2016-04-29 0.0025461940 0.0040794208 0.0219752355 0.021044190 3.933665e-03
## 2016-05-31 0.0001354312 -0.0376284873 -0.0008560276 0.004397029 1.686812e-02
## 2016-06-30 0.0191668605 0.0445822832 -0.0244914914 0.008292355 3.469884e-03
## 2016-07-29 0.0054295214 0.0524419934 0.0390000887 0.049348220 3.582208e-02
## 2016-08-31 -0.0021561516 0.0087988278 0.0053269936 0.011261352 1.196712e-03
## 2016-09-30 0.0005159681 0.0248725671 0.0132790411 0.008614743 5.775862e-05
## 2016-10-31 -0.0082049209 -0.0083121413 -0.0224038310 -0.038134961 -1.748885e-02
## 2016-11-30 -0.0259897503 -0.0451616758 -0.0179744583 0.125246227 3.617617e-02
## 2016-12-30 0.0025379605 -0.0025301957 0.0267030702 0.031491946 2.006892e-02
## 2017-01-31 0.0021261007 0.0644315990 0.0323818273 -0.012143851 1.773651e-02
## 2017-02-28 0.0064378170 0.0172578478 0.0118363775 0.013428683 3.853934e-02
## 2017-03-31 -0.0005529662 0.0361891761 0.0318057544 -0.006533174 1.249290e-03
## 2017-04-28 0.0090293354 0.0168662190 0.0239522527 0.005108086 9.876988e-03
## 2017-05-31 0.0068473361 0.0280599501 0.0348101874 -0.022862846 1.401435e-02
## 2017-06-30 -0.0001826585 0.0092236192 0.0029560598 0.029151886 6.354619e-03
## 2017-07-31 0.0033344765 0.0565947263 0.0261877950 0.007481575 2.034560e-02
## 2017-08-31 0.0093696180 0.0232437087 -0.0004485126 -0.027564747 2.913726e-03
## 2017-09-29 -0.0057330210 -0.0004462721 0.0233429060 0.082321564 1.994902e-02
## 2017-10-31 0.0009781557 0.0322786091 0.0166537666 0.005916133 2.329078e-02
## 2017-11-30 -0.0014836524 -0.0038970433 0.0068700619 0.036913170 3.010825e-02
## 2017-12-29 0.0047401380 0.0369252818 0.0133983571 -0.003731152 1.205462e-02# Covariance of asset returns
covariance_matrix <- cov(asset_returns_wide_tbl)
covariance_matrix## AGG EEM EFA IJS SPY
## AGG 7.398389e-05 0.0001042088 4.178082e-05 -0.0000781217 -9.031797e-06
## EEM 1.042088e-04 0.0017547083 1.039016e-03 0.0006437718 6.795411e-04
## EFA 4.178082e-05 0.0010390156 1.064239e-03 0.0006490300 6.975402e-04
## IJS -7.812170e-05 0.0006437718 6.490300e-04 0.0015654487 8.290241e-04
## SPY -9.031797e-06 0.0006795411 6.975402e-04 0.0008290241 7.408269e-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.02347488# 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.0003874014 0.009257136 0.005815635 0.005684464 0.002330247rowSums(component_contribution)## [1] 0.02347488# 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.0062311753 -0.0029354841 0.0366064478 0.052133476 4.992261e-02
## 2013-02-28 0.0058912346 -0.0231055201 -0.0129696694 0.016175319 1.267831e-02
## 2013-03-28 0.0009849994 -0.0102350379 0.0129696694 0.040258336 3.726812e-02
## 2013-04-30 0.0096393165 0.0120848714 0.0489677331 0.001221917 1.903029e-02
## 2013-05-31 -0.0202143132 -0.0494832470 -0.0306555723 0.041976532 2.333506e-02
## 2013-06-28 -0.0157779818 -0.0547282986 -0.0271444699 -0.001402890 -1.343394e-02
## 2013-07-31 0.0026878782 0.0131596068 0.0518601944 0.063541012 5.038561e-02
## 2013-08-30 -0.0082980387 -0.0257054581 -0.0197463287 -0.034743171 -3.045106e-02
## 2013-09-30 0.0111432151 0.0695887396 0.0753385173 0.063873387 3.115566e-02
## 2013-10-31 0.0082922475 0.0408610462 0.0320818277 0.034234476 4.526638e-02
## 2013-11-29 -0.0025098794 -0.0025939880 0.0054496043 0.041661092 2.920735e-02
## 2013-12-31 -0.0055830616 -0.0040741678 0.0215280253 0.012892252 2.559617e-02
## 2014-01-31 0.0152919117 -0.0903224452 -0.0534133163 -0.035775278 -3.588472e-02
## 2014-02-28 0.0037567610 0.0332203232 0.0595051246 0.045257345 4.451045e-02
## 2014-03-31 -0.0014818965 0.0380217395 -0.0046026585 0.013315014 8.261281e-03
## 2014-04-30 0.0081835274 0.0077728675 0.0165293759 -0.023184273 6.927492e-03
## 2014-05-30 0.0117209376 0.0290908548 0.0158282324 0.006205572 2.294116e-02
## 2014-06-30 -0.0005749806 0.0237339757 0.0091655973 0.037718736 2.043482e-02
## 2014-07-31 -0.0025123686 0.0135558042 -0.0263795824 -0.052009486 -1.352884e-02
## 2014-08-29 0.0114310294 0.0279045008 0.0018002621 0.043657937 3.870474e-02
## 2014-09-30 -0.0061673343 -0.0808566524 -0.0395983871 -0.061260437 -1.389231e-02
## 2014-10-31 0.0105841894 0.0140965813 -0.0026547524 0.068874579 2.327767e-02
## 2014-11-28 0.0065491454 -0.0155414175 0.0006250736 0.004773962 2.710140e-02
## 2014-12-31 0.0014750586 -0.0404421868 -0.0407465766 0.025295704 -2.539622e-03
## 2015-01-30 0.0203150371 -0.0068956229 0.0062263686 -0.054627952 -3.007684e-02
## 2015-02-27 -0.0089881695 0.0431359184 0.0614506437 0.056914620 5.468141e-02
## 2015-03-31 0.0037403241 -0.0150862344 -0.0143887809 0.010156422 -1.583014e-02
## 2015-04-30 -0.0032328335 0.0662814221 0.0358166738 -0.018417837 9.786096e-03
## 2015-05-29 -0.0043838332 -0.0419110980 0.0019524833 0.007509873 1.277413e-02
## 2015-06-30 -0.0108253644 -0.0297462661 -0.0316788973 0.004171328 -2.052116e-02
## 2015-07-31 0.0085844389 -0.0651784670 0.0201146780 -0.027375187 2.233778e-02
## 2015-08-31 -0.0033639886 -0.0925123720 -0.0771525052 -0.047268272 -6.288674e-02
## 2015-09-30 0.0080818303 -0.0318248313 -0.0451949278 -0.038465001 -2.584712e-02
## 2015-10-30 0.0006853663 0.0618083342 0.0640261035 0.063589922 8.163506e-02
## 2015-11-30 -0.0038982201 -0.0255603443 -0.0075560265 0.024415157 3.648443e-03
## 2015-12-31 -0.0019189459 -0.0389473005 -0.0235950341 -0.052157051 -1.743350e-02
## 2016-01-29 0.0123294527 -0.0516365772 -0.0567578138 -0.060307025 -5.106882e-02
## 2016-02-29 0.0088321572 -0.0082115852 -0.0339139975 0.020605402 -8.262119e-04
## 2016-03-31 0.0087086832 0.1218788723 0.0637457067 0.089910366 6.510028e-02
## 2016-04-29 0.0025461940 0.0040794208 0.0219752355 0.021044190 3.933665e-03
## 2016-05-31 0.0001354312 -0.0376284873 -0.0008560276 0.004397029 1.686812e-02
## 2016-06-30 0.0191668605 0.0445822832 -0.0244914914 0.008292355 3.469884e-03
## 2016-07-29 0.0054295214 0.0524419934 0.0390000887 0.049348220 3.582208e-02
## 2016-08-31 -0.0021561516 0.0087988278 0.0053269936 0.011261352 1.196712e-03
## 2016-09-30 0.0005159681 0.0248725671 0.0132790411 0.008614743 5.775862e-05
## 2016-10-31 -0.0082049209 -0.0083121413 -0.0224038310 -0.038134961 -1.748885e-02
## 2016-11-30 -0.0259897503 -0.0451616758 -0.0179744583 0.125246227 3.617617e-02
## 2016-12-30 0.0025379605 -0.0025301957 0.0267030702 0.031491946 2.006892e-02
## 2017-01-31 0.0021261007 0.0644315990 0.0323818273 -0.012143851 1.773651e-02
## 2017-02-28 0.0064378170 0.0172578478 0.0118363775 0.013428683 3.853934e-02
## 2017-03-31 -0.0005529662 0.0361891761 0.0318057544 -0.006533174 1.249290e-03
## 2017-04-28 0.0090293354 0.0168662190 0.0239522527 0.005108086 9.876988e-03
## 2017-05-31 0.0068473361 0.0280599501 0.0348101874 -0.022862846 1.401435e-02
## 2017-06-30 -0.0001826585 0.0092236192 0.0029560598 0.029151886 6.354619e-03
## 2017-07-31 0.0033344765 0.0565947263 0.0261877950 0.007481575 2.034560e-02
## 2017-08-31 0.0093696180 0.0232437087 -0.0004485126 -0.027564747 2.913726e-03
## 2017-09-29 -0.0057330210 -0.0004462721 0.0233429060 0.082321564 1.994902e-02
## 2017-10-31 0.0009781557 0.0322786091 0.0166537666 0.005916133 2.329078e-02
## 2017-11-30 -0.0014836524 -0.0038970433 0.0068700619 0.036913170 3.010825e-02
## 2017-12-29 0.0047401380 0.0369252818 0.0133983571 -0.003731152 1.205462e-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 from
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 from
pivot_longer(cols = everything(), names_to = "Asset", values_to = "Contribution") %>%
# Add Weights
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)