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.0062304862 -0.002935242 0.0366064890 0.052133419 0.0499231114
## 2013-02-28 0.0058914999 -0.023105457 -0.0129696606 0.016175136 0.0126780436
## 2013-03-28 0.0009840951 -0.010235012 0.0129696606 0.040258198 0.0372679131
## 2013-04-30 0.0096392965 0.012085018 0.0489677138 0.001222769 0.0190307116
## 2013-05-31 -0.0202143242 -0.049483490 -0.0306557725 0.041976175 0.0233350277
## 2013-06-28 -0.0157779420 -0.054728448 -0.0271442917 -0.001402946 -0.0134345749
## 2013-07-31 0.0026875403 0.013159761 0.0518602560 0.063541343 0.0503862173
## 2013-08-30 -0.0082981357 -0.025705612 -0.0197461995 -0.034743650 -0.0304517049
## 2013-09-30 0.0111440309 0.069588604 0.0753384098 0.063873833 0.0311561121
## 2013-10-31 0.0082921343 0.040861306 0.0320817953 0.034234107 0.0452665809
## 2013-11-29 -0.0025101584 -0.002593914 0.0054496212 0.041661007 0.0292070353
## 2013-12-31 -0.0055825811 -0.004074362 0.0215279752 0.012891964 0.0255963740
## 2014-01-31 0.0152911485 -0.090322685 -0.0534134659 -0.035774996 -0.0358847361
## 2014-02-28 0.0037574826 0.033220664 0.0595052487 0.045257247 0.0445100996
## 2014-03-31 -0.0014818209 0.038021935 -0.0046026436 0.013315354 0.0082615147
## 2014-04-30 0.0081832345 0.007772509 0.0165293705 -0.023184358 0.0069277627
## 2014-05-30 0.0117219867 0.029091079 0.0158285748 0.006205142 0.0229409866
## 2014-06-30 -0.0005762926 0.023734166 0.0091651842 0.037718808 0.0204346863
## 2014-07-31 -0.0025117738 0.013555355 -0.0263797076 -0.052009291 -0.0135287334
## 2014-08-29 0.0114304619 0.027904792 0.0018004227 0.043657969 0.0387046452
## 2014-09-30 -0.0061676122 -0.080856682 -0.0395984935 -0.061260619 -0.0138923761
## 2014-10-31 0.0105850917 0.014096564 -0.0026548113 0.068875056 0.0232777910
## 2014-11-28 0.0065485495 -0.015541295 0.0006253892 0.004773254 0.0271017536
## 2014-12-31 0.0014749538 -0.040442222 -0.0407466449 0.025296062 -0.0025401012
## 2015-01-30 0.0203156280 -0.006896096 0.0062262577 -0.054627971 -0.0300768986
## 2015-02-27 -0.0089886938 0.043136379 0.0614506994 0.056914789 0.0546815450
## 2015-03-31 0.0037406823 -0.015086135 -0.0143888628 0.010156163 -0.0158301064
## 2015-04-30 -0.0032335538 0.066281407 0.0358167361 -0.018417669 0.0097858662
## 2015-05-29 -0.0043833436 -0.041911352 0.0019524970 0.007509950 0.0127743072
## 2015-06-30 -0.0108254631 -0.029746500 -0.0316786743 0.004171446 -0.0205214450
## 2015-07-31 0.0085846526 -0.065178196 0.0201144823 -0.027375747 0.0223381483
## 2015-08-31 -0.0033642543 -0.092512485 -0.0771524036 -0.047268114 -0.0628869554
## 2015-09-30 0.0080819502 -0.031824717 -0.0451948928 -0.038464715 -0.0258468656
## 2015-10-30 0.0006852592 0.061808437 0.0640258868 0.063589794 0.0816351279
## 2015-11-30 -0.0038977972 -0.025560605 -0.0075557984 0.024415184 0.0036481908
## 2015-12-31 -0.0019192883 -0.038947247 -0.0235949440 -0.052156988 -0.0174335669
## 2016-01-29 0.0123299781 -0.051636463 -0.0567579867 -0.060306861 -0.0510686612
## 2016-02-29 0.0088315936 -0.008211756 -0.0339139014 0.020605037 -0.0008262107
## 2016-03-31 0.0087087724 0.121879069 0.0637455167 0.089910344 0.0651000668
## 2016-04-29 0.0025466496 0.004079216 0.0219754377 0.021044463 0.0039334794
## 2016-05-31 0.0001350422 -0.037628444 -0.0008562977 0.004397115 0.0168685493
## 2016-06-30 0.0191667175 0.044582471 -0.0244916243 0.008292251 0.0034698006
## 2016-07-29 0.0054292954 0.052442278 0.0390003689 0.049348092 0.0358220702
## 2016-08-31 -0.0021555702 0.008798536 0.0053267805 0.011261392 0.0011967358
## 2016-09-30 0.0005160947 0.024872507 0.0132791596 0.008614667 0.0000578937
## 2016-10-31 -0.0082054843 -0.008312009 -0.0224035856 -0.038134713 -0.0174888886
## 2016-11-30 -0.0259899093 -0.045161963 -0.0179744820 0.125246086 0.0361760604
## 2016-12-30 0.0025378989 -0.002529818 0.0267027783 0.031491742 0.0200690115
## 2017-01-31 0.0021267435 0.064431515 0.0323817996 -0.012143598 0.0177365377
## 2017-02-28 0.0064377882 0.017257601 0.0118365518 0.013428560 0.0385393372
## 2017-03-31 -0.0005532418 0.036189104 0.0318057133 -0.006533452 0.0012490866
## 2017-04-28 0.0090290990 0.016866399 0.0239522905 0.005108207 0.0098773083
## 2017-05-31 0.0068478338 0.028059769 0.0348100411 -0.022862626 0.0140140844
## 2017-06-30 -0.0001828249 0.009223875 0.0029561422 0.029151995 0.0063547608
## 2017-07-31 0.0033345506 0.056594446 0.0261877263 0.007481251 0.0203456490
## 2017-08-31 0.0093687681 0.023244075 -0.0004482935 -0.027564675 0.0029136566
## 2017-09-29 -0.0057317504 -0.000446495 0.0233428450 0.082321900 0.0199490758
## 2017-10-31 0.0009775716 0.032278478 0.0166535960 0.005915744 0.0232908143
## 2017-11-30 -0.0014839345 -0.003896856 0.0068700389 0.036913515 0.0301077395
## 2017-12-29 0.0047402535 0.036925396 0.0133984686 -0.003731246 0.0120550613# Covariance of asset returns
covariance_matrix <- cov(asset_returns_wide_tbl)
covariance_matrix## AGG EEM EFA IJS SPY
## AGG 7.398455e-05 0.0001042109 0.0000417835 -7.811962e-05 -9.031167e-06
## EEM 1.042109e-04 0.0017547132 0.0010390177 6.437744e-04 6.795448e-04
## EFA 4.178350e-05 0.0010390177 0.0010642379 6.490300e-04 6.975424e-04
## IJS -7.811962e-05 0.0006437744 0.0006490300 1.565449e-03 8.290236e-04
## SPY -9.031167e-06 0.0006795448 0.0006975424 8.290236e-04 7.408303e-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.02347492# 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.0003874191 0.009257153 0.005815636 0.005684465 0.002330251rowSums(component_contribution)## [1] 0.02347492# 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
asset_returns_wide_tbl <- asset_returns_tbl %>%
pivot_wider(names_from = asset, values_from = returns) %>%
column_to_rownames(var = "date")
calculate_component_contribution <- function(asset_returns_wide_tbl, w) {
covariance_matrix <- cov(asset_returns_wide_tbl)
sd_portfolio <- sqrt(t(w) %*% covariance_matrix %*% w)
component_contribution <- (t(w) %*% covariance_matrix * w) / sd_portfolio[1,1]
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
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)
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") 