# Load packages
# Core
library(tidyverse)
library(tidyquant)
library(readr)
# Time series
library(lubridate)
library(tibbletime)
# modeling
library(broom)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
symbols <- c("SPY", "EFA", "IJS", "EEM", "AGG")
prices <- tq_get(x = symbols,
get = "stock.prices",
from = "2012-12-31",
to = "2017-12-31")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"))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.0062308161 -0.0029350213 0.0366064924 0.052133532 4.992267e-02
## 2013-02-28 0.0058907073 -0.0231054516 -0.0129694779 0.016174926 1.267867e-02
## 2013-03-28 0.0009849787 -0.0102351239 0.0129694779 0.040258510 3.726773e-02
## 2013-04-30 0.0096395235 0.0120845651 0.0489678045 0.001222466 1.903024e-02
## 2013-05-31 -0.0202140980 -0.0494830326 -0.0306555943 0.041976183 2.333515e-02
## 2013-06-28 -0.0157786288 -0.0547284410 -0.0271446531 -0.001402752 -1.343388e-02
## 2013-07-31 0.0026880980 0.0131596979 0.0518603522 0.063541434 5.038598e-02
## 2013-08-30 -0.0082981936 -0.0257056738 -0.0197460238 -0.034743835 -3.045136e-02
## 2013-09-30 0.0111438911 0.0695890775 0.0753382389 0.063874016 3.115588e-02
## 2013-10-31 0.0082919385 0.0408609464 0.0320817979 0.034233591 4.526678e-02
## 2013-11-29 -0.0025100362 -0.0025940278 0.0054495424 0.041661516 2.920692e-02
## 2013-12-31 -0.0055828098 -0.0040742473 0.0215282111 0.012892206 2.559577e-02
## 2014-01-31 0.0152918969 -0.0903225489 -0.0534135434 -0.035775655 -3.588433e-02
## 2014-02-28 0.0037567350 0.0332205346 0.0595051717 0.045257503 4.451010e-02
## 2014-03-31 -0.0014813658 0.0380216967 -0.0046025666 0.013315434 8.261612e-03
## 2014-04-30 0.0081829966 0.0077726260 0.0165293705 -0.023184358 6.927078e-03
## 2014-05-30 0.0117214516 0.0290913038 0.0158287247 0.006205464 2.294157e-02
## 2014-06-30 -0.0005756922 0.0237337214 0.0091651086 0.037718564 2.043459e-02
## 2014-07-31 -0.0025120199 0.0135555745 -0.0263797818 -0.052009531 -1.352854e-02
## 2014-08-29 0.0114307695 0.0279046866 0.0018004227 0.043658054 3.870409e-02
## 2014-09-30 -0.0061674208 -0.0808565766 -0.0395984144 -0.061260375 -1.389183e-02
## 2014-10-31 0.0105850070 0.0140966769 -0.0026548905 0.068874890 2.327788e-02
## 2014-11-28 0.0065485197 -0.0155415215 0.0006253892 0.004773408 2.710122e-02
## 2014-12-31 0.0014746488 -0.0404421073 -0.0407467275 0.025295983 -2.539662e-03
## 2015-01-30 0.0203156241 -0.0068958558 0.0062265045 -0.054628126 -3.007707e-02
## 2015-02-27 -0.0089885385 0.0431361387 0.0614505352 0.056914868 5.468189e-02
## 2015-03-31 0.0037402464 -0.0150863686 -0.0143887845 0.010156163 -1.583028e-02
## 2015-04-30 -0.0032330296 0.0662814223 0.0358165066 -0.018417593 9.785778e-03
## 2015-05-29 -0.0043833831 -0.0419111338 0.0019526482 0.007510024 1.277422e-02
## 2015-06-30 -0.0108257175 -0.0297465004 -0.0316787522 0.004171296 -2.052118e-02
## 2015-07-31 0.0085850163 -0.0651780085 0.0201144838 -0.027375593 2.233772e-02
## 2015-08-31 -0.0033640850 -0.0925123296 -0.0771523273 -0.047268268 -6.288679e-02
## 2015-09-30 0.0080816437 -0.0318252020 -0.0451949791 -0.038464715 -2.584705e-02
## 2015-10-30 0.0006849433 0.0618083790 0.0640260539 0.063589872 8.163506e-02
## 2015-11-30 -0.0038978977 -0.0255604047 -0.0075559609 0.024415106 3.648619e-03
## 2015-12-31 -0.0019189830 -0.0389471047 -0.0235949460 -0.052157150 -1.743356e-02
## 2016-01-29 0.0123298296 -0.0516366796 -0.0567577266 -0.060306871 -5.106893e-02
## 2016-02-29 0.0088318400 -0.0082114548 -0.0339140781 0.020605124 -8.264856e-04
## 2016-03-31 0.0087087824 0.1218789097 0.0637456024 0.089910736 6.510078e-02
## 2016-04-29 0.0025460283 0.0040794156 0.0219750165 0.021044081 3.933222e-03
## 2016-05-31 0.0001352283 -0.0376286408 -0.0008557943 0.004397041 1.686855e-02
## 2016-06-30 0.0191671023 0.0445823356 -0.0244916202 0.008292252 3.469716e-03
## 2016-07-29 0.0054300326 0.0524421561 0.0390001969 0.049348382 3.582199e-02
## 2016-08-31 -0.0021564302 0.0087986623 0.0053269451 0.011261181 1.196978e-03
## 2016-09-30 0.0005160566 0.0248728111 0.0132789138 0.008614667 5.789369e-05
## 2016-10-31 -0.0082050587 -0.0083122517 -0.0224035044 -0.038134787 -1.748930e-02
## 2016-11-30 -0.0259898659 -0.0451618353 -0.0179744820 0.125246167 3.617623e-02
## 2016-12-30 0.0025380697 -0.0025299462 0.0267030253 0.031491806 2.006909e-02
## 2017-01-31 0.0021260742 0.0644312752 0.0323818714 -0.012143785 1.773646e-02
## 2017-02-28 0.0064377600 0.0172579591 0.0118363905 0.013428563 3.853912e-02
## 2017-03-31 -0.0005525301 0.0361889862 0.0318055557 -0.006532959 1.249527e-03
## 2017-04-28 0.0090288237 0.0168665113 0.0239522905 0.005107897 9.877016e-03
## 2017-05-31 0.0068476054 0.0280596567 0.0348103289 -0.022862752 1.401423e-02
## 2017-06-30 -0.0001829502 0.0092239826 0.0029557109 0.029151998 6.354761e-03
## 2017-07-31 0.0033342168 0.0565944397 0.0261879397 0.007481494 2.034572e-02
## 2017-08-31 0.0093698343 0.0232438736 -0.0004482935 -0.027564672 2.913587e-03
## 2017-09-29 -0.0057323363 -0.0004462957 0.0233427068 0.082321776 1.994928e-02
## 2017-10-31 0.0009775866 0.0322785714 0.0166537315 0.005915858 2.329048e-02
## 2017-11-30 -0.0014838072 -0.0038970489 0.0068699050 0.036913291 3.010800e-02
## 2017-12-29 0.0047402864 0.0369253964 0.0133983378 -0.003730915 1.205500e-02# Covariance of asset returns
covariance_matrix <- cov(asset_returns_wide_tbl)
covariance_matrix## AGG EEM EFA IJS SPY
## AGG 7.398520e-05 0.0001042102 0.0000417827 -7.812132e-05 -9.032003e-06
## EEM 1.042102e-04 0.0017547093 0.0010390162 6.437773e-04 6.795431e-04
## EFA 4.178270e-05 0.0010390162 0.0010642374 6.490306e-04 6.975403e-04
## IJS -7.812132e-05 0.0006437773 0.0006490306 1.565454e-03 8.290267e-04
## SPY -9.032003e-06 0.0006795431 0.0006975403 8.290267e-04 7.408281e-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.0003874126 0.009257145 0.005815632 0.00568448 0.002330249rowSums(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.099