Code along 12
Joseph Hansen
2023-12-06
# 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.0062305453 -0.0029352688 0.0366062650 0.052133149 4.992235e-02
## 2013-02-28 0.0058909631 -0.0231054073 -0.0129694909 0.016175424 1.267813e-02
## 2013-03-28 0.0009847306 -0.0102350357 0.0129694909 0.040257839 3.726813e-02
## 2013-04-30 0.0096390512 0.0120848687 0.0489676492 0.001222713 1.903041e-02
## 2013-05-31 -0.0202139585 -0.0494834671 -0.0306554884 0.041975948 2.333472e-02
## 2013-06-28 -0.0157777060 -0.0547283597 -0.0271445588 -0.001402413 -1.343406e-02
## 2013-07-31 0.0026874190 0.0131597885 0.0518603677 0.063541358 5.038651e-02
## 2013-08-30 -0.0082985025 -0.0257057642 -0.0197463271 -0.034743616 -3.045183e-02
## 2013-09-30 0.0111443195 0.0695889252 0.0753385111 0.063873468 3.115611e-02
## 2013-10-31 0.0082920624 0.0408611570 0.0320816706 0.034234302 4.526679e-02
## 2013-11-29 -0.0025104241 -0.0025940988 0.0054496048 0.041661253 2.920713e-02
## 2013-12-31 -0.0055829717 -0.0040741678 0.0215281022 0.012892091 2.559617e-02
## 2014-01-31 0.0152920045 -0.0903225673 -0.0534133163 -0.035775443 -3.588491e-02
## 2014-02-28 0.0037567613 0.0332202091 0.0595049750 0.045257116 4.451025e-02
## 2014-03-31 -0.0014813577 0.0380219757 -0.0046023586 0.013315641 8.261573e-03
## 2014-04-30 0.0081829892 0.0077725291 0.0165292256 -0.023184268 6.927202e-03
## 2014-05-30 0.0117216430 0.0290913028 0.0158283779 0.006205254 2.294117e-02
## 2014-06-30 -0.0005753327 0.0237339731 0.0091656681 0.037718663 2.043473e-02
## 2014-07-31 -0.0025127213 0.0135555916 -0.0263800207 -0.052009655 -1.352846e-02
## 2014-08-29 0.0114309431 0.0279048117 0.0018004102 0.043658182 3.870482e-02
## 2014-09-30 -0.0061675990 -0.0808569690 -0.0395986207 -0.061260523 -1.389267e-02
## 2014-10-31 0.0105846287 0.0140964731 -0.0026545221 0.068875124 2.327785e-02
## 2014-11-28 0.0065495773 -0.0155411980 0.0006252277 0.004773581 2.710149e-02
## 2014-12-31 0.0014742818 -0.0404420707 -0.0407467338 0.025295778 -2.539621e-03
## 2015-01-30 0.0203159736 -0.0068957389 0.0062265285 -0.054628105 -3.007747e-02
## 2015-02-27 -0.0089888463 0.0431360303 0.0614504891 0.056914624 5.468220e-02
## 2015-03-31 0.0037404093 -0.0150860054 -0.0143886299 0.010156130 -1.583013e-02
## 2015-04-30 -0.0032328335 0.0662809748 0.0358165244 -0.018417322 9.785495e-03
## 2015-05-29 -0.0043836620 -0.0419109916 0.0019528496 0.007509946 1.277439e-02
## 2015-06-30 -0.0108256221 -0.0297462661 -0.0316790390 0.004171401 -2.052134e-02
## 2015-07-31 0.0085846113 -0.0651784060 0.0201145268 -0.027375406 2.233803e-02
## 2015-08-31 -0.0033635579 -0.0925121655 -0.0771525052 -0.047268427 -6.288664e-02
## 2015-09-30 0.0080813138 -0.0318251679 -0.0451947603 -0.038464675 -2.584712e-02
## 2015-10-30 0.0006851956 0.0618082085 0.0640257005 0.063589830 8.163479e-02
## 2015-11-30 -0.0038982208 -0.0255602827 -0.0075556327 0.024414927 3.648359e-03
## 2015-12-31 -0.0019187745 -0.0389471673 -0.0235951113 -0.052156975 -1.743333e-02
## 2016-01-29 0.0123298766 -0.0516365772 -0.0567577233 -0.060307025 -5.106864e-02
## 2016-02-29 0.0088316492 -0.0082116587 -0.0339140803 0.020605651 -8.262117e-04
## 2016-03-31 0.0087088505 0.1218790109 0.0637457845 0.089910269 6.509993e-02
## 2016-04-29 0.0025462768 0.0040792910 0.0219749876 0.021043891 3.933497e-03
## 2016-05-31 0.0001351819 -0.0376285571 -0.0008558647 0.004397251 1.686862e-02
## 2016-06-30 0.0191669436 0.0445824177 -0.0244914894 0.008292354 3.469801e-03
## 2016-07-29 0.0054296835 0.0524422376 0.0390000855 0.049348426 3.582216e-02
## 2016-08-31 -0.0021560700 0.0087985231 0.0053269932 0.011260936 1.196553e-03
## 2016-09-30 0.0005159680 0.0248727457 0.0132788824 0.008614608 5.799761e-05
## 2016-10-31 -0.0082052463 -0.0083121403 -0.0224036715 -0.038134830 -1.748900e-02
## 2016-11-30 -0.0259899205 -0.0451616703 -0.0179743747 0.125246368 3.617593e-02
## 2016-12-30 0.0025384640 -0.0025302578 0.0267029060 0.031491825 2.006923e-02
## 2017-01-31 0.0021259329 0.0644315366 0.0323819047 -0.012143975 1.773635e-02
## 2017-02-28 0.0064376503 0.0172580780 0.0118363766 0.013428686 3.853934e-02
## 2017-03-31 -0.0005531325 0.0361887239 0.0318056038 -0.006532810 1.249145e-03
## 2017-04-28 0.0090294200 0.0168664410 0.0239523267 0.005107722 9.877276e-03
## 2017-05-31 0.0068474190 0.0280599501 0.0348103271 -0.022862727 1.401428e-02
## 2017-06-30 -0.0001829040 0.0092236192 0.0029559201 0.029152010 6.354549e-03
## 2017-07-31 0.0033348855 0.0565946270 0.0261877950 0.007481336 2.034574e-02
## 2017-08-31 0.0093692132 0.0232438081 -0.0004483769 -0.027564570 2.913519e-03
## 2017-09-29 -0.0057322101 -0.0004463693 0.0233428366 0.082321738 1.994909e-02
## 2017-10-31 0.0009779116 0.0322786122 0.0166537003 0.005915795 2.329078e-02
## 2017-11-30 -0.0014839773 -0.0038968548 0.0068700619 0.036913287 3.010781e-02
## 2017-12-29 0.0047400574 0.0369253694 0.0133982932 -0.003730935 1.205538e-02# Covariance of asset returns
covariance_matrix <- cov(asset_returns_wide_tbl)
covariance_matrix## AGG EEM EFA IJS SPY
## AGG 7.398510e-05 0.0001042099 4.178258e-05 -7.812064e-05 -9.031942e-06
## EEM 1.042099e-04 0.0017547101 1.039016e-03 6.437753e-04 6.795437e-04
## EFA 4.178258e-05 0.0010390156 1.064237e-03 6.490305e-04 6.975416e-04
## IJS -7.812064e-05 0.0006437753 6.490305e-04 1.565450e-03 8.290258e-04
## SPY -9.031942e-06 0.0006795437 6.975416e-04 8.290258e-04 7.408302e-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.02347491# 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.000387413 0.009257144 0.005815631 0.005684472 0.002330251rowSums(component_contribution)## [1] 0.02347491# 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.0062305453 -0.0029352688 0.0366062650 0.052133149 4.992235e-02
## 2013-02-28 0.0058909631 -0.0231054073 -0.0129694909 0.016175424 1.267813e-02
## 2013-03-28 0.0009847306 -0.0102350357 0.0129694909 0.040257839 3.726813e-02
## 2013-04-30 0.0096390512 0.0120848687 0.0489676492 0.001222713 1.903041e-02
## 2013-05-31 -0.0202139585 -0.0494834671 -0.0306554884 0.041975948 2.333472e-02
## 2013-06-28 -0.0157777060 -0.0547283597 -0.0271445588 -0.001402413 -1.343406e-02
## 2013-07-31 0.0026874190 0.0131597885 0.0518603677 0.063541358 5.038651e-02
## 2013-08-30 -0.0082985025 -0.0257057642 -0.0197463271 -0.034743616 -3.045183e-02
## 2013-09-30 0.0111443195 0.0695889252 0.0753385111 0.063873468 3.115611e-02
## 2013-10-31 0.0082920624 0.0408611570 0.0320816706 0.034234302 4.526679e-02
## 2013-11-29 -0.0025104241 -0.0025940988 0.0054496048 0.041661253 2.920713e-02
## 2013-12-31 -0.0055829717 -0.0040741678 0.0215281022 0.012892091 2.559617e-02
## 2014-01-31 0.0152920045 -0.0903225673 -0.0534133163 -0.035775443 -3.588491e-02
## 2014-02-28 0.0037567613 0.0332202091 0.0595049750 0.045257116 4.451025e-02
## 2014-03-31 -0.0014813577 0.0380219757 -0.0046023586 0.013315641 8.261573e-03
## 2014-04-30 0.0081829892 0.0077725291 0.0165292256 -0.023184268 6.927202e-03
## 2014-05-30 0.0117216430 0.0290913028 0.0158283779 0.006205254 2.294117e-02
## 2014-06-30 -0.0005753327 0.0237339731 0.0091656681 0.037718663 2.043473e-02
## 2014-07-31 -0.0025127213 0.0135555916 -0.0263800207 -0.052009655 -1.352846e-02
## 2014-08-29 0.0114309431 0.0279048117 0.0018004102 0.043658182 3.870482e-02
## 2014-09-30 -0.0061675990 -0.0808569690 -0.0395986207 -0.061260523 -1.389267e-02
## 2014-10-31 0.0105846287 0.0140964731 -0.0026545221 0.068875124 2.327785e-02
## 2014-11-28 0.0065495773 -0.0155411980 0.0006252277 0.004773581 2.710149e-02
## 2014-12-31 0.0014742818 -0.0404420707 -0.0407467338 0.025295778 -2.539621e-03
## 2015-01-30 0.0203159736 -0.0068957389 0.0062265285 -0.054628105 -3.007747e-02
## 2015-02-27 -0.0089888463 0.0431360303 0.0614504891 0.056914624 5.468220e-02
## 2015-03-31 0.0037404093 -0.0150860054 -0.0143886299 0.010156130 -1.583013e-02
## 2015-04-30 -0.0032328335 0.0662809748 0.0358165244 -0.018417322 9.785495e-03
## 2015-05-29 -0.0043836620 -0.0419109916 0.0019528496 0.007509946 1.277439e-02
## 2015-06-30 -0.0108256221 -0.0297462661 -0.0316790390 0.004171401 -2.052134e-02
## 2015-07-31 0.0085846113 -0.0651784060 0.0201145268 -0.027375406 2.233803e-02
## 2015-08-31 -0.0033635579 -0.0925121655 -0.0771525052 -0.047268427 -6.288664e-02
## 2015-09-30 0.0080813138 -0.0318251679 -0.0451947603 -0.038464675 -2.584712e-02
## 2015-10-30 0.0006851956 0.0618082085 0.0640257005 0.063589830 8.163479e-02
## 2015-11-30 -0.0038982208 -0.0255602827 -0.0075556327 0.024414927 3.648359e-03
## 2015-12-31 -0.0019187745 -0.0389471673 -0.0235951113 -0.052156975 -1.743333e-02
## 2016-01-29 0.0123298766 -0.0516365772 -0.0567577233 -0.060307025 -5.106864e-02
## 2016-02-29 0.0088316492 -0.0082116587 -0.0339140803 0.020605651 -8.262117e-04
## 2016-03-31 0.0087088505 0.1218790109 0.0637457845 0.089910269 6.509993e-02
## 2016-04-29 0.0025462768 0.0040792910 0.0219749876 0.021043891 3.933497e-03
## 2016-05-31 0.0001351819 -0.0376285571 -0.0008558647 0.004397251 1.686862e-02
## 2016-06-30 0.0191669436 0.0445824177 -0.0244914894 0.008292354 3.469801e-03
## 2016-07-29 0.0054296835 0.0524422376 0.0390000855 0.049348426 3.582216e-02
## 2016-08-31 -0.0021560700 0.0087985231 0.0053269932 0.011260936 1.196553e-03
## 2016-09-30 0.0005159680 0.0248727457 0.0132788824 0.008614608 5.799761e-05
## 2016-10-31 -0.0082052463 -0.0083121403 -0.0224036715 -0.038134830 -1.748900e-02
## 2016-11-30 -0.0259899205 -0.0451616703 -0.0179743747 0.125246368 3.617593e-02
## 2016-12-30 0.0025384640 -0.0025302578 0.0267029060 0.031491825 2.006923e-02
## 2017-01-31 0.0021259329 0.0644315366 0.0323819047 -0.012143975 1.773635e-02
## 2017-02-28 0.0064376503 0.0172580780 0.0118363766 0.013428686 3.853934e-02
## 2017-03-31 -0.0005531325 0.0361887239 0.0318056038 -0.006532810 1.249145e-03
## 2017-04-28 0.0090294200 0.0168664410 0.0239523267 0.005107722 9.877276e-03
## 2017-05-31 0.0068474190 0.0280599501 0.0348103271 -0.022862727 1.401428e-02
## 2017-06-30 -0.0001829040 0.0092236192 0.0029559201 0.029152010 6.354549e-03
## 2017-07-31 0.0033348855 0.0565946270 0.0261877950 0.007481336 2.034574e-02
## 2017-08-31 0.0093692132 0.0232438081 -0.0004483769 -0.027564570 2.913519e-03
## 2017-09-29 -0.0057322101 -0.0004463693 0.0233428366 0.082321738 1.994909e-02
## 2017-10-31 0.0009779116 0.0322786122 0.0166537003 0.005915795 2.329078e-02
## 2017-11-30 -0.0014839773 -0.0038968548 0.0068700619 0.036913287 3.010781e-02
## 2017-12-29 0.0047400574 0.0369253694 0.0133982932 -0.003730935 1.205538e-02cal_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 %>% cal_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 %>%
cal_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 %>%
cal_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)
## 6 Rolling Component Contribution