# Load packages
# Core
library(tidyverse)
library(tidyquant)
Examine how each asset contributes to portfolio standard deviation. This is to ensure that our risk is not concentrated in any one asset.
Choose your stocks from 2012-12-31 to present.
symbols <- c("AAPL", "NKE", "WMT", "AMZN", "NFLX")
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"))
# 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
## AAPL AMZN NFLX NKE WMT
## 2013-01-31 -0.1555894772 0.0566799395 0.579217807 0.0463876035 0.0248962168
## 2013-02-28 -0.0256109798 -0.0046435024 0.129468379 0.0114290051 0.0117956058
## 2013-03-28 0.0028506234 0.0083654162 0.006360071 0.0802402477 0.0620734423
## 2013-04-30 0.0002704339 -0.0487507497 0.132375020 0.0749067119 0.0378936698
## 2013-05-31 0.0221723082 0.0588686246 0.046038179 -0.0276355518 -0.0317797673
## 2013-06-28 -0.1258959284 0.0310507506 -0.069356059 0.0322352351 -0.0046876684
## 2013-07-31 0.1321024440 0.0813355350 0.146848883 -0.0120066145 0.0452745632
## 2013-08-30 0.0804425591 -0.0695574090 0.149523815 0.0017287361 -0.0597001110
## 2013-09-30 -0.0217234703 0.1067688897 0.085363345 0.1452422457 0.0133389529
## 2013-10-31 0.0920151136 0.1521839116 0.042020452 0.0420549184 0.0370289780
## 2013-11-29 0.0677083813 0.0781496860 0.126045633 0.0436480982 0.0540192738
## 2013-12-31 0.0088619944 0.0130490386 0.006458091 -0.0032101153 -0.0232522823
## 2014-01-31 -0.1139491413 -0.1059765119 0.105976906 -0.0764774416 -0.0523039173
## 2014-02-28 0.0559184777 0.0094619003 0.084967340 0.0752097418 0.0002681804
## 2014-03-31 0.0197563089 -0.0737086161 -0.235772622 -0.0583757240 0.0293256912
## 2014-04-30 0.0947609142 -0.1007565303 -0.089040653 -0.0123976701 0.0420196041
## 2014-05-30 0.0757654569 0.0273091844 0.260398864 0.0560136764 -0.0314090022
## 2014-06-30 0.0272863895 0.0383836202 0.053062785 0.0082870957 -0.0223929703
## 2014-07-31 0.0283262732 -0.0369768154 -0.041427371 -0.0054306537 -0.0200475106
## 2014-08-29 0.0746517477 0.0799468404 0.122147235 0.0212580024 0.0323257336
## 2014-09-30 -0.0172207845 -0.0502010184 -0.056990921 0.1271455166 0.0127658565
## 2014-10-31 0.0694889415 -0.0540982347 -0.138642147 0.0413961331 -0.0026188349
## 2014-11-28 0.1007310130 0.1031187277 -0.125081717 0.0657676927 0.1378160603
## 2014-12-31 -0.0746062259 -0.0872368614 -0.014472733 -0.0292637846 -0.0135735952
## 2015-01-30 0.0596113052 0.1330922557 0.257187512 -0.0414073670 -0.0105351798
## 2015-02-27 0.0960162023 0.0697992426 0.072268016 0.0543412717 -0.0124329024
## 2015-03-31 -0.0318744272 -0.0214295755 -0.130782770 0.0325173203 -0.0142311771
## 2015-04-30 0.0057700455 0.1253212736 0.289324652 -0.0149623969 -0.0524136353
## 2015-05-29 0.0443407970 0.0175090293 0.114579343 0.0309563504 -0.0433513465
## 2015-06-30 -0.0379379551 0.0112589814 0.051346180 0.0605839904 -0.0460138552
## 2015-07-31 -0.0334808541 0.2111621090 0.197231490 0.0645269140 0.0146950011
## 2015-08-31 -0.0684890637 -0.0443525782 0.006278919 -0.0305790229 -0.0993581511
## 2015-09-30 -0.0220577122 -0.0019516837 -0.107942853 0.0982088311 0.0016978214
## 2015-10-30 0.0801124161 0.2010808743 0.048393445 0.0634859589 -0.1246698376
## 2015-11-30 -0.0058213295 0.0602956777 0.129220160 0.0094946795 0.0275687826
## 2015-12-31 -0.1167901716 0.0165440008 -0.075337490 -0.0541859135 0.0492992595
## 2016-01-29 -0.0782236697 -0.1410054620 -0.219478322 -0.0078711107 0.0793147120
## 2016-02-29 -0.0012881752 -0.0605352209 0.016950552 -0.0067962719 -0.0003012712
## 2016-03-31 0.1197460995 0.0717834363 0.090226765 0.0006246398 0.0392705104
## 2016-04-29 -0.1507312292 0.1053453760 -0.127082275 -0.0420291605 -0.0239373427
## 2016-05-31 0.0693142399 0.0915002899 0.130402555 -0.0651947819 0.0641205568
## 2016-06-30 -0.0435960862 -0.0099694639 -0.114425083 0.0025546410 0.0311573910
## 2016-07-29 0.0862348218 0.0586021229 -0.002517413 0.0054201479 -0.0006851772
## 2016-08-31 0.0233766897 0.0135476418 0.065736402 0.0378336957 -0.0143680951
## 2016-09-30 0.0634482819 0.0848953908 0.011224670 -0.0877706513 0.0094730314
## 2016-10-31 0.0043251485 -0.0583893058 0.236709154 -0.0480497018 -0.0295501309
## 2016-11-30 -0.0218378601 -0.0509721927 -0.065099283 -0.0021948034 0.0058384913
## 2016-12-30 0.0468407920 -0.0009330556 0.056493450 0.0186665785 -0.0116435373
## 2017-01-31 0.0466417607 0.0936394059 0.128033698 0.0399166314 -0.0350396165
## 2017-02-28 0.1255550899 0.0258446800 0.010041084 0.0774507790 0.0608888541
## 2017-03-31 0.0475410970 0.0479423007 0.039185483 -0.0222245286 0.0234091209
## 2017-04-28 -0.0000696606 0.0424566944 0.029267777 -0.0057588406 0.0421088827
## 2017-05-31 0.0656077835 0.0725778018 0.068984176 -0.0446568580 0.0511560031
## 2017-06-30 -0.0589159640 -0.0271286156 -0.087485372 0.1108370248 -0.0378575012
## 2017-07-31 0.0321804606 0.0202278808 0.195442599 0.0008469054 0.0553871930
## 2017-08-31 0.1016530622 -0.0072953953 -0.039009333 -0.1082534506 -0.0180254164
## 2017-09-29 -0.0621347402 -0.0198260355 0.037301404 -0.0183455530 0.0008965266
## 2017-10-31 0.0924037175 0.1395154056 0.079877197 0.0587964157 0.1109630081
## 2017-11-30 0.0200753667 0.0626577318 -0.046100666 0.0941687048 0.1076141606
## 2017-12-29 -0.0153635042 -0.0062057845 0.023081621 0.0379618543 0.0207686279
calculate_component_contribution1 <- 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
w <- c(0.25, 0.25, 0.2, 0.2, 0.1)
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_contribution1(w = c(.25, .25, .2, .2, .1))
## # A tibble: 1 × 5
## AAPL AMZN NFLX NKE WMT
## <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 0.202 0.298 0.409 0.075 0.016
plot_data1 <- asset_returns_wide_tbl %>%
calculate_component_contribution1(w = c(.25, .25, .2, .2, .1)) %>%
# Transform to long form
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_data1 %>%
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 = .5)) +
theme_tq() +
labs(title = "Percent Contribution to Portfolio Standard Deviation",
y = "Percent",
x = NULL)
Which of the assets in your portfolio the largest contributor to the portfolio volatility? Do you think your portfolio risk is concentrated in any one asset?
Netflix contributes the most to the portfolio’s volatility, making up a little over 30% of it, even though its weight in the portfolio is only 20%. While the portfolio’s risk isn’t focused on just one asset, Netflix carries the most risk. AMZN and AAPL also contribute significantly, while WMT has the least risk at under 5%, and NKE is just below 15%