Apply it to Your Data 12
Ethan Daly
2022-12-14
# Load packages
# Core
library(tidyverse)## ── Attaching packages ─────────────────────────────────────── tidyverse 1.3.2 ──
## ✔ ggplot2 3.3.6 ✔ purrr 0.3.5
## ✔ tibble 3.1.8 ✔ dplyr 1.0.10
## ✔ tidyr 1.2.0 ✔ stringr 1.4.1
## ✔ readr 2.1.2 ✔ forcats 0.5.2
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()library(tidyquant)## Loading required package: lubridate
##
## Attaching package: 'lubridate'
##
## The following objects are masked from 'package:base':
##
## date, intersect, setdiff, union
##
## Loading required package: PerformanceAnalytics
## Loading required package: xts
## Loading required package: zoo
##
## Attaching package: 'zoo'
##
## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numeric
##
##
## Attaching package: 'xts'
##
## The following objects are masked from 'package:dplyr':
##
## first, last
##
##
## Attaching package: 'PerformanceAnalytics'
##
## The following object is masked from 'package:graphics':
##
## legend
##
## Loading required package: quantmod
## Loading required package: TTR
## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoo##Goal Examine how each asset contributes to portfolio standard deviation. This is to ensure that our risk is not concentrated in any one asset.
1 Import stock prices
symbol <- c("BIG", "TSLA", "AMZN", "WM", "PLUG")
prices <- tq_get(x = symbol,
get = "stock.prices",
from = "2012-12-31",
to = "2022-12-4")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"))## asset date returns
## "asset" "date" "returns"3 Calculate Component Contribution to Portfolio Volatility
# Transform data into wide form
asset_returns_wide_tbl <- asset_returns_tbl %>%
pivot_wider(names_from = symbol, values_from = monthly.returns) %>%
column_to_rownames(var = "date")
asset_returns_wide_tbl## AMZN BIG PLUG TSLA WM
## 2013-01-31 0.0566799640 0.1219132745 -0.105360516 0.1020780306 7.533523e-02
## 2013-02-28 -0.0046435329 0.0351445900 -0.973449146 -0.0741286130 2.551044e-02
## 2013-03-28 0.0083654117 0.0574754369 0.257829109 0.0842081407 5.925445e-02
## 2013-04-30 -0.0487507638 0.0320852241 -0.318453731 0.3541115266 4.415218e-02
## 2013-05-31 0.0588686422 -0.0672880253 0.864997437 0.5937166927 2.291751e-02
## 2013-06-28 0.0310507858 -0.0768903122 0.000000000 0.0936721824 -3.012887e-02
## 2013-07-31 0.0813355112 0.1361840151 0.146603474 0.2237395455 4.128814e-02
## 2013-08-30 -0.0695574024 -0.0198470357 0.186102280 0.2299715724 -3.856480e-02
## 2013-09-30 0.1067688764 0.0460709866 0.333773180 0.1347066817 2.872214e-02
## 2013-10-31 0.1521839130 -0.0198785310 -0.243622083 -0.1898066500 5.427128e-02
## 2013-11-29 0.0781496951 0.0527637989 0.243622083 -0.2284094314 4.798040e-02
## 2013-12-31 0.0130490358 -0.1714753021 0.739360024 0.1671085482 -9.868851e-03
## 2014-01-31 -0.1059765070 -0.1867289687 0.667001900 0.1872617700 -7.135140e-02
## 2014-02-28 0.0094619111 0.0980551895 0.435902240 0.2997227569 -6.724479e-03
## 2014-03-31 -0.0737086127 0.2480754845 0.418935712 -0.1607831916 2.275399e-02
## 2014-04-30 -0.1007565625 0.0421412679 -0.423227564 -0.0026901587 5.503015e-02
## 2014-05-30 0.0273092148 0.0717905924 -0.066691374 -0.0005773950 5.161096e-03
## 2014-06-30 0.0383835737 0.0740072806 0.073122265 0.1444572175 9.548452e-03
## 2014-07-31 -0.0369767889 -0.0398254211 0.146797706 -0.0723727109 3.571026e-03
## 2014-08-29 0.0799468534 0.0577301246 0.029092961 0.1887940489 4.529386e-02
## 2014-09-30 -0.0502010221 -0.0701863068 -0.195308752 -0.1055665065 1.981844e-02
## 2014-10-31 -0.0540982353 0.0586414959 0.025807884 -0.0040464567 2.821184e-02
## 2014-11-28 0.1031187000 0.1068924852 -0.209437485 0.0115997563 -3.278106e-03
## 2014-12-31 -0.0872368443 -0.2343282464 -0.241638134 -0.0947745205 5.949820e-02
## 2015-01-30 0.1330922758 0.1373038661 -0.116533816 -0.0883652428 2.141196e-03
## 2015-02-27 0.0697991955 0.0384574156 0.142851125 -0.0012778053 5.761190e-02
## 2015-03-31 -0.0214295288 0.0105038675 -0.173271721 -0.0743500856 2.416260e-03
## 2015-04-30 0.1253212631 -0.0525763382 -0.019493795 0.1802268445 -9.065577e-02
## 2015-05-29 0.0175090073 -0.0373351934 0.068467799 0.1038995352 2.420009e-03
## 2015-06-30 0.0112589801 0.0286651104 -0.104543856 0.0673009664 -6.097838e-02
## 2015-07-31 0.2111621241 -0.0410628275 0.055569851 -0.0078966182 9.815016e-02
## 2015-08-31 -0.0443525737 0.1056151695 -0.415164505 -0.0663662659 -2.114928e-02
## 2015-09-30 -0.0019516780 0.0025954526 0.067822596 -0.0026535416 2.703201e-03
## 2015-10-30 0.2010808557 -0.0387202003 0.275310781 -0.1826597420 7.631385e-02
## 2015-11-30 0.0602956898 -0.0243725019 -0.091169387 0.1068285793 1.858830e-04
## 2015-12-31 0.0165439780 -0.1497585814 -0.041769413 0.0414715455 -3.007934e-04
## 2016-01-29 -0.1410054619 0.0062076495 -0.120749517 -0.2273606457 -7.900829e-03
## 2016-02-29 -0.0605352242 0.0421620807 0.106429463 0.0038106694 5.332156e-02
## 2016-03-31 0.0717834457 0.1177907490 -0.014528101 0.1799481124 6.207654e-02
## 2016-04-29 0.1053453885 0.0125069275 0.004866190 0.0467217989 -3.565589e-03
## 2016-05-31 0.0915002937 0.1314031676 -0.070380797 -0.0755979774 3.608197e-02
## 2016-06-30 -0.0099694796 -0.0387943359 -0.031748698 -0.0502964721 9.043318e-02
## 2016-07-29 0.0586021200 0.0594618243 -0.038360868 0.1007853609 -2.266033e-03
## 2016-08-31 0.0135476463 -0.0753526934 -0.143960689 -0.1020580755 -3.352624e-02
## 2016-09-30 0.0848953859 -0.0280939639 0.098238440 -0.0383664015 3.542892e-03
## 2016-10-31 -0.0583892995 -0.0955199320 -0.111225635 -0.0313645781 2.936394e-02
## 2016-11-30 -0.0509721788 0.1536898677 -0.110456996 -0.0430412566 6.296620e-02
## 2016-12-30 -0.0009330597 -0.0040922169 -0.132489183 0.1206651595 1.979727e-02
## 2017-01-31 0.0936394046 -0.0041909550 -0.124052649 0.1646249442 -2.008473e-02
## 2017-02-28 0.0258446771 0.0264472613 0.018692133 -0.0077303938 5.350647e-02
## 2017-03-31 0.0479423059 -0.0480542454 0.245122458 0.1072787335 3.924457e-04
## 2017-04-28 0.0424566809 0.0365071462 0.484392367 0.1209162404 -1.921556e-03
## 2017-05-31 0.0725778079 -0.0334304861 -0.185899378 0.0822958674 1.784707e-03
## 2017-06-30 -0.0271286060 -0.0057175299 0.092373320 0.0586544693 1.182278e-02
## 2017-07-31 0.0202278723 0.0279695131 0.102415005 -0.1114598383 2.424360e-02
## 2017-08-31 -0.0072953921 -0.0425681725 -0.054558984 0.0955434172 2.574690e-02
## 2017-09-29 -0.0198260414 0.1234334653 0.198544392 -0.0424741171 2.052946e-02
## 2017-10-31 0.1395154081 -0.0431035359 0.087968773 -0.0284574314 4.862624e-02
## 2017-11-30 0.0626577388 0.1413452232 -0.184429039 -0.0708625359 6.130376e-03
## 2017-12-29 -0.0062057977 -0.0467170627 -0.004228336 0.0080619271 4.806598e-02
## 2018-01-31 0.2156265512 0.0792341546 -0.201141616 0.1292546011 2.438176e-02
## 2018-02-28 0.0415536373 -0.0783441396 -0.036943515 -0.0322668767 -2.414978e-02
## 2018-03-29 -0.0440034786 -0.2488858473 0.016000341 -0.2539204060 -2.035078e-02
## 2018-04-30 0.0788802990 -0.0251238178 -0.032260862 0.0992545378 -3.422155e-02
## 2018-05-31 0.0397392491 -0.0369519188 0.021622464 -0.0316981426 1.731773e-02
## 2018-06-29 0.0421636779 0.0281792234 0.077159081 0.1860432866 -1.113711e-02
## 2018-07-31 0.0446635758 0.0387324831 -0.009950331 -0.1400215248 1.011721e-01
## 2018-08-31 0.1243079035 -0.0087880077 -0.015113638 0.0117373977 9.950240e-03
## 2018-09-28 -0.0048359762 -0.0225725142 -0.025708357 -0.1304390165 -8.656996e-04
## 2018-10-31 -0.2258870091 -0.0064817958 -0.037139547 0.2421705735 -9.898270e-03
## 2018-11-30 0.0560700362 0.0479641465 -0.055569851 0.0382715929 5.175102e-02
## 2018-12-31 -0.1180514840 -0.3994981301 -0.344504408 -0.0517619931 -5.210754e-02
## 2019-01-31 0.1348080379 0.0867230840 0.099699360 -0.0806287869 7.238059e-02
## 2019-02-28 -0.0469930675 -0.0003170188 0.267404880 0.0410330178 5.668802e-02
## 2019-03-29 0.0824420113 0.1959088324 0.293253118 -0.1336564496 3.108549e-02
## 2019-04-30 0.0786806236 -0.0228791251 0.036813973 -0.1591238004 3.247620e-02
## 2019-05-31 -0.0818753437 -0.2974172157 0.027724548 -0.2539453437 1.855246e-02
## 2019-06-28 0.0646557723 0.0463609336 -0.129077042 0.1880120886 5.812316e-02
## 2019-07-31 -0.0142806642 -0.1111639962 -0.017937701 0.0780923684 1.402935e-02
## 2019-08-30 -0.0496880811 -0.1180272499 -0.018265348 -0.0685169061 1.988646e-02
## 2019-09-30 -0.0229951136 0.0865253705 0.192256679 0.0654495641 -3.286713e-02
## 2019-10-31 0.0232034025 -0.1227441758 0.007575794 0.2680612231 -2.456009e-02
## 2019-11-29 0.0134958246 -0.0361797169 0.386416913 0.0465921656 6.218926e-03
## 2019-12-31 0.0257863460 0.3285359890 -0.210404526 0.2373597511 1.381246e-02
## 2020-01-31 0.0834803057 -0.0595371083 0.202682479 0.4415783462 6.571138e-02
## 2020-02-28 -0.0642332025 -0.5374138724 0.114619841 0.0264242489 -9.374202e-02
## 2020-03-31 0.0344213016 -0.0783417481 -0.203747621 -0.2427814625 -1.754189e-01
## 2020-04-30 0.2381504772 0.5002212616 0.166184519 0.4002095471 7.751309e-02
## 2020-05-29 -0.0128673704 0.5022601582 0.007151401 0.0657304983 6.511948e-02
## 2020-06-30 0.1218341292 0.0887310273 0.667890276 0.2571086531 -2.942652e-03
## 2020-07-31 0.1372488981 -0.0654278253 -0.062834736 0.2814206802 3.424780e-02
## 2020-08-31 0.0866005697 0.1810922848 0.520891524 0.5547193155 3.936111e-02
## 2020-09-30 -0.0916533239 -0.0491444023 0.032590986 -0.1497623077 -2.521502e-03
## 2020-10-30 -0.0364089200 0.0650987240 0.043056632 -0.1003717709 -4.759356e-02
## 2020-11-30 0.0425228235 0.0820447507 0.633927783 0.3803085230 9.891773e-02
## 2020-12-31 0.0276719595 -0.1785541963 0.250724844 0.2177307540 -5.460187e-03
## 2021-01-29 -0.0156985927 0.3294260479 0.622119517 0.1173437008 -5.768235e-02
## 2021-02-26 -0.0359675611 0.0626727782 -0.266742947 -0.1610382032 -3.870308e-03
## 2021-03-31 0.0003717143 0.0766878995 -0.300021938 -0.0112698364 1.561651e-01
## 2021-04-30 0.1139202371 0.0093266351 -0.228809685 0.0602925648 6.706886e-02
## 2021-05-28 -0.0730764730 -0.1233468035 0.074007784 -0.1263723441 1.945147e-02
## 2021-06-30 0.0651836186 0.0841826849 0.107670487 0.0835479560 2.274053e-05
## 2021-07-30 -0.0332696344 -0.1361100021 -0.225779305 0.0109738463 5.653983e-02
## 2021-08-31 0.0421339383 -0.1688388041 -0.045752336 0.0682242642 4.516690e-02
## 2021-09-30 -0.0550034402 -0.1087982396 -0.020155644 0.0526326134 -3.407856e-02
## 2021-10-29 0.0262547660 0.0203179869 0.404420410 0.3622302039 7.025059e-02
## 2021-11-30 0.0391473427 -0.0198568390 0.040456056 0.0272378466 2.742457e-03
## 2021-12-31 -0.0505062023 0.0446205530 -0.344737113 -0.0799684394 4.163103e-02
## 2022-01-31 -0.1085098100 -0.0722483520 -0.255269362 -0.1205974768 -1.038305e-01
## 2022-02-28 0.0263230081 -0.1870573201 0.145293220 -0.0733970107 -4.097714e-02
## 2022-03-31 0.0596239187 0.0034749194 0.123347242 0.2135042897 9.736516e-02
## 2022-04-29 -0.2711856809 -0.1130975001 -0.308281977 -0.2131252902 3.679114e-02
## 2022-05-31 -0.0333130912 -0.2324912303 -0.128785299 -0.1383400625 -3.672811e-02
## 2022-06-30 -0.1238178220 -0.1551721264 -0.109095235 -0.1186571232 -3.140193e-02
## 2022-07-29 0.2394860603 -0.0379053565 0.252989414 0.2804801477 7.296812e-02
## 2022-08-31 -0.0625299199 0.0186462769 0.273048852 -0.0752502731 2.680099e-02
## 2022-09-30 -0.1149865786 -0.2626533042 -0.288633583 -0.0383139910 -4.984230e-02
## 2022-10-31 -0.0981105379 0.1896617414 -0.273660575 -0.1533467611 -1.155149e-02
## 2022-11-30 -0.0593198403 0.0328409793 -0.001252348 -0.1558661194 5.736196e-02
## 2022-12-02 -0.0252806669 -0.0695424782 -0.009442941 0.0008214602 1.626723e-02calculate_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
## AMZN BIG PLUG TSLA WM
## <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 0.1 0.158 0.445 0.265 0.0326 Plot: Colum Chart of Component Contribution and Weight
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 the portfolio’s volatility is “PLUG”, which contributes nearly 45% of all the volatility. There are two assets that hold roughly 70% of all the risk which are “PLUG” and “TSLA” the burden of risk mostly falls on them and the other stocks make up for their lack of safety.