# 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("MCD", "WEN", "YUM", "DPZ", "SBUX")
prices <- tq_get(x = symbols,
get = "stock.prices",
from = "2012-12-31",
to = "2021-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
## DPZ MCD SBUX WEN YUM
## 2013-01-31 0.0670469363 7.720448e-02 0.045383644 0.0894902796 -0.0170693911
## 2013-02-28 0.0222960421 1.441582e-02 -0.019138610 0.1106729534 0.0082809721
## 2013-03-28 0.0811968619 3.875971e-02 0.037571218 -0.0035152559 0.0940875104
## 2013-04-30 0.0705472517 2.427874e-02 0.066074118 0.0017587434 -0.0495329404
## 2013-05-31 0.0711403768 -4.827202e-02 0.040473451 0.0513147200 -0.0054466839
## 2013-06-28 -0.0157273487 2.485151e-02 0.036848327 -0.0203741489 0.0231974472
## 2013-07-31 0.0734196545 -9.336358e-03 0.084553372 0.1984854691 0.0549407748
## 2013-08-30 -0.0183844556 -3.061979e-02 -0.008017026 0.0679089638 -0.0405821470
## 2013-09-30 0.1038071588 1.941632e-02 0.087519542 0.1148391453 0.0193769596
## 2013-10-31 -0.0131847703 3.216900e-03 0.051650810 0.0244622919 -0.0490780040
## 2013-11-29 0.0304010516 1.705057e-02 0.008261009 -0.0035108662 0.1386938624
## 2013-12-31 0.0103658195 -3.498168e-03 -0.038415519 0.0126946551 -0.0270093692
## 2014-01-31 0.0136892298 -2.991845e-02 -0.097328069 0.0393530321 -0.1135939208
## 2014-02-28 0.1130350476 1.883611e-02 0.001524548 0.0596241343 0.0982167127
## 2014-03-31 -0.0236235092 2.981895e-02 0.033535129 -0.0492077800 0.0175288346
## 2014-04-30 -0.0342289091 3.360218e-02 -0.038337929 -0.0930101230 0.0258614620
## 2014-05-30 -0.0262900134 8.521548e-03 0.040101064 -0.0072684166 0.0041476908
## 2014-06-30 0.0122223055 -6.826214e-03 0.054986709 0.0394552699 0.0490919989
## 2014-07-31 -0.0150253401 -6.330852e-02 0.003869512 -0.0455713923 -0.1525226738
## 2014-08-29 0.0468041849 -3.280305e-04 0.005031113 0.0061843304 0.0427339791
## 2014-09-30 0.0231010194 1.156322e-02 -0.030666872 0.0134062269 -0.0062327258
## 2014-10-31 0.1429885029 -1.145665e-02 0.001324216 -0.0294858457 0.0039779124
## 2014-11-28 0.0554233347 4.113335e-02 0.076233046 0.0900592634 0.0727446933
## 2014-12-31 0.0060866408 -3.265209e-02 0.010290935 0.0349332300 -0.0586444748
## 2015-01-30 0.0505232216 -1.353816e-02 0.064652671 0.1546253370 -0.0021923522
## 2015-02-27 0.0247292426 7.620196e-02 0.069516131 0.0557064821 0.1152587266
## 2015-03-31 -0.0065636451 -1.487236e-02 0.012859721 -0.0172805926 -0.0299090478
## 2015-04-30 0.0700860514 -9.175581e-03 0.046020761 -0.0742492668 0.0932357096
## 2015-05-29 0.0074823668 2.210194e-03 0.050062896 0.1098226727 0.0471489563
## 2015-06-30 0.0454595328 -9.005226e-03 0.031447949 0.0035523171 -0.0003329138
## 2015-07-31 0.0038727947 4.915552e-02 0.077313372 -0.0947783060 -0.0216255064
## 2015-08-31 -0.0719211684 -4.090995e-02 -0.054435644 -0.1129483058 -0.0954583355
## 2015-09-30 0.0213009334 3.627366e-02 0.038193976 -0.0518138007 0.0022540544
## 2015-10-30 -0.0115575742 1.303674e-01 0.096045531 0.0572869903 -0.1133950875
## 2015-11-30 0.0074718059 2.468262e-02 -0.015806455 0.1432063689 0.0223130051
## 2015-12-31 0.0374077159 3.426925e-02 -0.022402484 0.0244373240 0.0074195846
## 2016-01-29 0.0238041416 4.663537e-02 0.012251689 -0.0514401988 -0.0027182219
## 2016-02-29 0.1550656497 -4.716196e-02 -0.039776252 -0.0814080677 0.0013809494
## 2016-03-31 -0.0060479685 6.994227e-02 0.025274774 0.1503321178 0.1217157655
## 2016-04-29 -0.0869426055 6.424329e-03 -0.059881644 -0.0027588450 -0.0227549242
## 2016-05-31 0.0000000000 -3.565029e-02 -0.020626194 -0.0490497417 0.0313048840
## 2016-06-30 0.0863100118 -6.868041e-03 0.039823177 -0.0663553649 0.0100599795
## 2016-07-29 0.1143774094 -2.260713e-02 0.016150316 0.0041490838 0.0808169461
## 2016-08-31 0.0152930317 -9.317642e-03 -0.028378032 0.0594128982 0.0143231182
## 2016-09-30 0.0176617283 -2.597111e-03 -0.037876901 0.0581398430 0.0011019560
## 2016-10-31 0.1084248011 -2.448249e-02 -0.019961414 0.0036968315 -0.0454365705
## 2016-11-30 -0.0071157389 6.556070e-02 0.092935164 0.1531057039 0.0217314010
## 2016-12-30 -0.0514392925 2.033362e-02 -0.043182282 0.0728569399 -0.0009470711
## 2017-01-31 0.0917415617 6.958959e-03 -0.005418083 0.0007394167 0.0387764677
## 2017-02-28 0.0838695859 4.794330e-02 0.033938604 0.0349868564 -0.0032097168
## 2017-03-31 -0.0269923463 1.523773e-02 0.026376827 -0.0239576093 -0.0219789338
## 2017-04-28 -0.0159153789 7.661245e-02 0.028199371 0.0797601849 0.0332292873
## 2017-05-31 0.1546151820 7.540873e-02 0.061537421 0.0968912516 0.0996558527
## 2017-06-30 0.0013588938 2.118116e-02 -0.086997033 -0.0416726920 0.0153010129
## 2017-07-31 -0.1259356335 1.284506e-02 -0.077160080 -0.0045235790 0.0271152411
## 2017-08-31 -0.0229969046 3.657370e-02 0.020675132 -0.0294725431 0.0175971272
## 2017-09-29 0.0880494698 -2.078101e-02 -0.021185458 0.0400709553 -0.0426841575
## 2017-10-31 -0.0815550245 6.324945e-02 0.020820862 -0.0208203707 0.0113469880
## 2017-11-30 0.0171204713 3.580902e-02 0.058198242 -0.0164867471 0.1181287645
## 2017-12-29 0.0174804570 8.717762e-04 -0.006767860 0.0978102695 -0.0225354229
## 2018-01-31 0.1376704651 -5.710206e-03 -0.010854418 -0.0147242993 0.0358639153
## 2018-02-28 0.0253166439 -7.522708e-02 0.010501129 -0.0090822910 -0.0340642888
## 2018-03-29 0.0513487472 -8.659326e-03 0.013740455 0.0955950645 0.0450498877
## 2018-04-30 0.0343823890 6.833619e-02 -0.005543033 -0.0472527533 0.0228775773
## 2018-05-31 0.0395419795 -4.538874e-02 -0.010541057 -0.0332334177 -0.0642265457
## 2018-06-29 0.1171588088 -1.463474e-02 -0.148490780 0.0643058248 -0.0389896542
## 2018-07-31 -0.0716492843 5.409862e-03 0.069961642 -0.0295357554 0.0135864945
## 2018-08-31 0.1281103935 3.555910e-02 0.026968495 0.0613390847 0.0958157791
## 2018-09-28 -0.0107437980 3.071392e-02 0.061493678 -0.0293207831 0.0452272351
## 2018-10-31 -0.0923667336 5.585545e-02 0.024847164 0.0058174982 -0.0055151752
## 2018-11-30 0.0312418501 6.971465e-02 0.140772232 0.0439605135 0.0239670082
## 2018-12-31 -0.1095783727 -5.978618e-02 -0.035391099 -0.1385634001 -0.0032583793
## 2019-01-31 0.1346346345 6.791090e-03 0.056450582 0.1039501507 0.0221634462
## 2019-02-28 -0.1228092147 3.425613e-02 0.035843545 0.0063478348 0.0099936462
## 2019-03-29 0.0307857032 3.243170e-02 0.056446624 0.0318025532 0.0546684147
## 2019-04-30 0.0472208786 3.959552e-02 0.043948682 0.0394570741 0.0448655469
## 2019-05-31 0.0324342091 9.376138e-03 -0.016446952 -0.0064513358 -0.0155552224
## 2019-06-28 -0.0020664871 4.627222e-02 0.097268369 0.0627016287 0.0781545091
## 2019-07-31 -0.1292899084 1.462816e-02 0.121817550 -0.0736365873 0.0165782034
## 2019-08-30 -0.0750932008 3.910077e-02 0.023339318 0.1946974522 0.0407755478
## 2019-09-30 0.0779513707 -1.506892e-02 -0.088066474 -0.0963107075 -0.0291058598
## 2019-10-31 0.1048207780 -8.760877e-02 -0.044636670 0.0583257131 -0.1090602769
## 2019-11-29 0.0801955133 -4.962200e-03 0.015222309 0.0177207335 -0.0059863573
## 2019-12-31 0.0004479098 1.596601e-02 0.028729765 0.0352841227 0.0005957882
## 2020-01-31 -0.0418110759 7.954051e-02 -0.035777912 -0.0246137354 0.0488232682
## 2020-02-28 0.1863357921 -9.086359e-02 -0.073793041 -0.1318317169 -0.1653539266
## 2020-03-31 -0.0440492327 -1.606694e-01 -0.176498865 -0.2380850502 -0.2641697073
## 2020-04-30 0.1104914030 1.260342e-01 0.154585360 0.2886897766 0.2320633440
## 2020-05-29 0.0639720454 1.223829e-05 0.021923061 0.0704776627 0.0426922371
## 2020-06-30 -0.0413948408 -9.978840e-03 -0.058071500 0.0241648091 -0.0319321647
## 2020-07-31 0.0454280587 5.181362e-02 0.039173576 0.0622974740 0.0465359551
## 2020-08-31 0.0562011470 1.002634e-01 0.104138803 -0.0993239176 0.0562547259
## 2020-09-30 0.0411085686 2.757620e-02 0.017020065 0.0629253321 -0.0486335054
## 2020-10-30 -0.1170074099 -3.001453e-02 0.012031760 -0.0203855059 0.0219907150
## 2020-11-30 0.0369744503 2.655676e-02 0.124427731 0.0095520897 0.1298951974
## 2020-12-31 -0.0214427470 -1.324033e-02 0.087470346 -0.0031882378 0.0257524382
## 2021-01-29 -0.0336804332 -3.191402e-02 -0.099891663 -0.0718645700 -0.0673428465
## 2021-02-26 -0.0676431847 -2.079074e-03 0.113906944 0.0014693870 0.0246826955
## 2021-03-31 0.0622268793 8.371533e-02 0.011412880 -0.0038725952 0.0439351607
## 2021-04-30 0.1382984364 5.189989e-02 0.046665642 0.1079730175 0.0996872281
## 2021-05-28 0.0106688664 -3.812136e-03 -0.001371345 0.0327458621 0.0079162638
## 2021-06-30 0.0908344224 -1.247638e-02 -0.018344234 0.0085763757 -0.0420486844
## 2021-07-30 0.1190945914 4.949286e-02 0.082536982 -0.0090072268 0.1329769553
## 2021-08-31 -0.0165009919 -1.640070e-02 -0.029111033 -0.0029449508 0.0009824885
## 2021-09-30 -0.0785566695 1.525402e-02 -0.063058640 -0.0599731340 -0.0688675042
## 2021-10-29 0.0248685443 1.824736e-02 -0.039195238 0.0281963609 0.0212747901
## 2021-11-30 0.0694576811 1.652253e-03 0.037405586 -0.0746011157 -0.0129933301
## 2021-12-30 0.0632928769 8.841047e-02 0.058454699 0.1483026646 0.1191930942
calculate_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 %>% calculate_component_contribution(w = c(0.2, 0.2, 0.2, 0.2, 0.2))
## # A tibble: 1 × 5
## DPZ MCD SBUX WEN YUM
## <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 0.147 0.142 0.192 0.268 0.25
plot_data <- asset_returns_wide_tbl %>%
calculate_component_contribution(w = c(0.2, 0.2, 0.2, 0.2, 0.2)) %>%
# Transform to long form
pivot_longer(cols = everything(), names_to = "Asset", values_to = "Contribution") %>%
# Add weights
add_column(weight = c(0.2, 0.2, 0.2, 0.2, 0.2)) %>%
# 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)
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?
The largest contributor to my portfolio’s volatility is the asset of “WEN” which represents Wendy’s food corporation. WEN has almost double the volatility of its competitor, MCD (McDonalds). I evenly weighted this portfolio with 20% allocation to each asset, and they are all fast food companies that are generally impacted by the same economic factors. For this reason, I do not think that risk is concentrated in one asset, other than the fact that Wendy’s seems to be a bit more volatile than the rest. Regardless, they all fall into the range of approximately 14 to 25% volatility, which is relatively limited.