Code Along 12
Jay Reynolds
2024-06-27
# Load packages
# Core
library(tidyverse)
library(tidyquant)
library(readr)
# Time series
library(lubridate)
# 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.0062310743 -0.0029352422 0.0366063041 0.052132970 4.992348e-02
## 2013-02-28 0.0058913556 -0.0231052278 -0.0129693860 0.016175507 1.267802e-02
## 2013-03-28 0.0009847117 -0.0102351227 0.0129693860 0.040258020 3.726781e-02
## 2013-04-30 0.0096391179 0.0120847897 0.0489676317 0.001222381 1.903047e-02
## 2013-05-31 -0.0202141681 -0.0494834901 -0.0306555106 0.041975951 2.333527e-02
## 2013-06-28 -0.0157782909 -0.0547285730 -0.0271443808 -0.001402714 -1.343424e-02
## 2013-07-31 0.0026884849 0.0131598249 0.0518601691 0.063541403 5.038601e-02
## 2013-08-30 -0.0082984543 -0.0257056135 -0.0197462012 -0.034743620 -3.045177e-02
## 2013-09-30 0.0111434937 0.0695889042 0.0753384984 0.063873871 3.115600e-02
## 2013-10-31 0.0082928272 0.0408610696 0.0320816361 0.034234236 4.526657e-02
## 2013-11-29 -0.0025101045 -0.0025935722 0.0054494637 0.041660957 2.920691e-02
## 2013-12-31 -0.0055836177 -0.0040745892 0.0215282920 0.012892459 2.559630e-02
## 2014-01-31 0.0152918036 -0.0903226115 -0.0534134659 -0.035775629 -3.588413e-02
## 2014-02-28 0.0037572870 0.0332206578 0.0595053258 0.045257661 4.451019e-02
## 2014-03-31 -0.0014818146 0.0380215195 -0.0046028755 0.013315034 8.261133e-03
## 2014-04-30 0.0081833996 0.0077727427 0.0165295253 -0.023184283 6.927662e-03
## 2014-05-30 0.0117214186 0.0290910789 0.0158283500 0.006205541 2.294084e-02
## 2014-06-30 -0.0005758135 0.0237340560 0.0091655576 0.037718720 2.043487e-02
## 2014-07-31 -0.0025120400 0.0135555730 -0.0263798561 -0.052009417 -1.352872e-02
## 2014-08-29 0.0114307325 0.0279046837 0.0018006510 0.043657852 3.870445e-02
## 2014-09-30 -0.0061676285 -0.0808567961 -0.0395986427 -0.061260582 -1.389206e-02
## 2014-10-31 0.0105850190 0.0140966785 -0.0026549699 0.068874815 2.327770e-02
## 2014-11-28 0.0065488227 -0.0155414089 0.0006253893 0.004773724 2.710161e-02
## 2014-12-31 0.0014749231 -0.0404419882 -0.0407465655 0.025295741 -2.539962e-03
## 2015-01-30 0.0203147038 -0.0068959748 0.0062264219 -0.054627866 -3.007726e-02
## 2015-02-27 -0.0089876674 0.0431361387 0.0614506124 0.056914558 5.468203e-02
## 2015-03-31 0.0037402243 -0.0150860189 -0.0143887833 0.010156305 -1.582987e-02
## 2015-04-30 -0.0032334239 0.0662815090 0.0358165794 -0.018417527 9.785472e-03
## 2015-05-29 -0.0043832503 -0.0419114564 0.0019524970 0.007509804 1.277429e-02
## 2015-06-30 -0.0108254190 -0.0297467314 -0.0316787522 0.004171309 -2.052110e-02
## 2015-07-31 0.0085848589 -0.0651779538 0.0201145601 -0.027375200 2.233769e-02
## 2015-08-31 -0.0033641020 -0.0925122670 -0.0771524861 -0.047268418 -6.288665e-02
## 2015-09-30 0.0080810644 -0.0318250603 -0.0451948966 -0.038464708 -2.584708e-02
## 2015-10-30 0.0006859772 0.0618083039 0.0640258921 0.063589640 8.163484e-02
## 2015-11-30 -0.0038984124 -0.0255604030 -0.0075557175 0.024415234 3.648733e-03
## 2015-12-31 -0.0019191784 -0.0389472441 -0.0235951109 -0.052157116 -1.743356e-02
## 2016-01-29 0.0123303034 -0.0516365338 -0.0567579965 -0.060306782 -5.106897e-02
## 2016-02-29 0.0088316451 -0.0082114542 -0.0339136333 0.020605146 -8.263322e-04
## 2016-03-31 0.0087088697 0.1218789011 0.0637456825 0.089910436 6.510044e-02
## 2016-04-29 0.0025460393 0.0040792159 0.0219749289 0.021044147 3.933751e-03
## 2016-05-31 0.0001354343 -0.0376283007 -0.0008560461 0.004397249 1.686802e-02
## 2016-06-30 0.0191667210 0.0445821945 -0.0244914523 0.008292190 3.469818e-03
## 2016-07-29 0.0054295991 0.0524422154 0.0390001141 0.049348466 3.582207e-02
## 2016-08-31 -0.0021565086 0.0087984128 0.0053270279 0.011261076 1.196943e-03
## 2016-09-30 0.0005163132 0.0248729959 0.0132791575 0.008614651 5.795815e-05
## 2016-10-31 -0.0082050677 -0.0083121901 -0.0224037481 -0.038134822 -1.748933e-02
## 2016-11-30 -0.0259897195 -0.0451617657 -0.0179745666 0.125246354 3.617629e-02
## 2016-12-30 0.0025380277 -0.0025300097 0.0267029452 0.031492155 2.006912e-02
## 2017-01-31 0.0021258798 0.0644312672 0.0323819564 -0.012144399 1.773649e-02
## 2017-02-28 0.0064382210 0.0172579571 0.0118365490 0.013428918 3.853909e-02
## 2017-03-31 -0.0005532638 0.0361887542 0.0318055533 -0.006533261 1.249290e-03
## 2017-04-28 0.0090294600 0.0168667372 0.0239520652 0.005107848 9.877294e-03
## 2017-05-31 0.0068472164 0.0280595448 0.0348101901 -0.022862324 1.401414e-02
## 2017-06-30 -0.0001822219 0.0092238748 0.0029559269 0.029151516 6.354753e-03
## 2017-07-31 0.0033343915 0.0565946495 0.0261879415 0.007481925 2.034571e-02
## 2017-08-31 0.0093687772 0.0232435724 -0.0004481537 -0.027564833 2.913560e-03
## 2017-09-29 -0.0057321292 -0.0004461962 0.0233427052 0.082321732 1.994900e-02
## 2017-10-31 0.0009777006 0.0322785746 0.0166536632 0.005915814 2.329090e-02
## 2017-11-30 -0.0014834263 -0.0038969524 0.0068700385 0.036913564 3.010804e-02
## 2017-12-29 0.0047398815 0.0369254897 0.0133984677 -0.003731525 1.205513e-02# Covariance of asset returns
covariance_matrix <- cov(asset_returns_wide_tbl)
covariance_matrix## AGG EEM EFA IJS SPY
## AGG 7.398415e-05 0.0001042106 4.178433e-05 -7.811549e-05 -9.028401e-06
## EEM 1.042106e-04 0.0017547100 1.039017e-03 6.437760e-04 6.795428e-04
## EFA 4.178433e-05 0.0010390175 1.064238e-03 6.490315e-04 6.975415e-04
## IJS -7.811549e-05 0.0006437760 6.490315e-04 1.565450e-03 8.290269e-04
## SPY -9.028401e-06 0.0006795428 6.975415e-04 8.290269e-04 7.408294e-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(.25, .25, .2, .2, .1)
sd_portfolio <- sqrt(t(w) %*% covariance_matrix %*% w)
sd_portfolio## [,1]
## [1,] 0.02347494# 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.0003874303 0.009257139 0.005815635 0.005684481 0.002330252rowSums(component_contribution)## [1] 0.02347494# 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.0062310743 -0.0029352422 0.0366063041 0.052132970 4.992348e-02
## 2013-02-28 0.0058913556 -0.0231052278 -0.0129693860 0.016175507 1.267802e-02
## 2013-03-28 0.0009847117 -0.0102351227 0.0129693860 0.040258020 3.726781e-02
## 2013-04-30 0.0096391179 0.0120847897 0.0489676317 0.001222381 1.903047e-02
## 2013-05-31 -0.0202141681 -0.0494834901 -0.0306555106 0.041975951 2.333527e-02
## 2013-06-28 -0.0157782909 -0.0547285730 -0.0271443808 -0.001402714 -1.343424e-02
## 2013-07-31 0.0026884849 0.0131598249 0.0518601691 0.063541403 5.038601e-02
## 2013-08-30 -0.0082984543 -0.0257056135 -0.0197462012 -0.034743620 -3.045177e-02
## 2013-09-30 0.0111434937 0.0695889042 0.0753384984 0.063873871 3.115600e-02
## 2013-10-31 0.0082928272 0.0408610696 0.0320816361 0.034234236 4.526657e-02
## 2013-11-29 -0.0025101045 -0.0025935722 0.0054494637 0.041660957 2.920691e-02
## 2013-12-31 -0.0055836177 -0.0040745892 0.0215282920 0.012892459 2.559630e-02
## 2014-01-31 0.0152918036 -0.0903226115 -0.0534134659 -0.035775629 -3.588413e-02
## 2014-02-28 0.0037572870 0.0332206578 0.0595053258 0.045257661 4.451019e-02
## 2014-03-31 -0.0014818146 0.0380215195 -0.0046028755 0.013315034 8.261133e-03
## 2014-04-30 0.0081833996 0.0077727427 0.0165295253 -0.023184283 6.927662e-03
## 2014-05-30 0.0117214186 0.0290910789 0.0158283500 0.006205541 2.294084e-02
## 2014-06-30 -0.0005758135 0.0237340560 0.0091655576 0.037718720 2.043487e-02
## 2014-07-31 -0.0025120400 0.0135555730 -0.0263798561 -0.052009417 -1.352872e-02
## 2014-08-29 0.0114307325 0.0279046837 0.0018006510 0.043657852 3.870445e-02
## 2014-09-30 -0.0061676285 -0.0808567961 -0.0395986427 -0.061260582 -1.389206e-02
## 2014-10-31 0.0105850190 0.0140966785 -0.0026549699 0.068874815 2.327770e-02
## 2014-11-28 0.0065488227 -0.0155414089 0.0006253893 0.004773724 2.710161e-02
## 2014-12-31 0.0014749231 -0.0404419882 -0.0407465655 0.025295741 -2.539962e-03
## 2015-01-30 0.0203147038 -0.0068959748 0.0062264219 -0.054627866 -3.007726e-02
## 2015-02-27 -0.0089876674 0.0431361387 0.0614506124 0.056914558 5.468203e-02
## 2015-03-31 0.0037402243 -0.0150860189 -0.0143887833 0.010156305 -1.582987e-02
## 2015-04-30 -0.0032334239 0.0662815090 0.0358165794 -0.018417527 9.785472e-03
## 2015-05-29 -0.0043832503 -0.0419114564 0.0019524970 0.007509804 1.277429e-02
## 2015-06-30 -0.0108254190 -0.0297467314 -0.0316787522 0.004171309 -2.052110e-02
## 2015-07-31 0.0085848589 -0.0651779538 0.0201145601 -0.027375200 2.233769e-02
## 2015-08-31 -0.0033641020 -0.0925122670 -0.0771524861 -0.047268418 -6.288665e-02
## 2015-09-30 0.0080810644 -0.0318250603 -0.0451948966 -0.038464708 -2.584708e-02
## 2015-10-30 0.0006859772 0.0618083039 0.0640258921 0.063589640 8.163484e-02
## 2015-11-30 -0.0038984124 -0.0255604030 -0.0075557175 0.024415234 3.648733e-03
## 2015-12-31 -0.0019191784 -0.0389472441 -0.0235951109 -0.052157116 -1.743356e-02
## 2016-01-29 0.0123303034 -0.0516365338 -0.0567579965 -0.060306782 -5.106897e-02
## 2016-02-29 0.0088316451 -0.0082114542 -0.0339136333 0.020605146 -8.263322e-04
## 2016-03-31 0.0087088697 0.1218789011 0.0637456825 0.089910436 6.510044e-02
## 2016-04-29 0.0025460393 0.0040792159 0.0219749289 0.021044147 3.933751e-03
## 2016-05-31 0.0001354343 -0.0376283007 -0.0008560461 0.004397249 1.686802e-02
## 2016-06-30 0.0191667210 0.0445821945 -0.0244914523 0.008292190 3.469818e-03
## 2016-07-29 0.0054295991 0.0524422154 0.0390001141 0.049348466 3.582207e-02
## 2016-08-31 -0.0021565086 0.0087984128 0.0053270279 0.011261076 1.196943e-03
## 2016-09-30 0.0005163132 0.0248729959 0.0132791575 0.008614651 5.795815e-05
## 2016-10-31 -0.0082050677 -0.0083121901 -0.0224037481 -0.038134822 -1.748933e-02
## 2016-11-30 -0.0259897195 -0.0451617657 -0.0179745666 0.125246354 3.617629e-02
## 2016-12-30 0.0025380277 -0.0025300097 0.0267029452 0.031492155 2.006912e-02
## 2017-01-31 0.0021258798 0.0644312672 0.0323819564 -0.012144399 1.773649e-02
## 2017-02-28 0.0064382210 0.0172579571 0.0118365490 0.013428918 3.853909e-02
## 2017-03-31 -0.0005532638 0.0361887542 0.0318055533 -0.006533261 1.249290e-03
## 2017-04-28 0.0090294600 0.0168667372 0.0239520652 0.005107848 9.877294e-03
## 2017-05-31 0.0068472164 0.0280595448 0.0348101901 -0.022862324 1.401414e-02
## 2017-06-30 -0.0001822219 0.0092238748 0.0029559269 0.029151516 6.354753e-03
## 2017-07-31 0.0033343915 0.0565946495 0.0261879415 0.007481925 2.034571e-02
## 2017-08-31 0.0093687772 0.0232435724 -0.0004481537 -0.027564833 2.913560e-03
## 2017-09-29 -0.0057321292 -0.0004461962 0.0233427052 0.082321732 1.994900e-02
## 2017-10-31 0.0009777006 0.0322785746 0.0166536632 0.005915814 2.329090e-02
## 2017-11-30 -0.0014834263 -0.0038969524 0.0068700385 0.036913564 3.010804e-02
## 2017-12-29 0.0047398815 0.0369254897 0.0133984677 -0.003731525 1.205513e-02calculate_component_contribution <- function(.data, w) {
# Covariance of asset returns
covariance_matrix <- cov(asset_returns_wide_tbl)
# 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
# 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")
6 Rolling Component Contribution
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)) %>%
# Transfrom 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)