# 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.
symbols <- c("DIS", "AAPL", "NKE", "SBUX", "GE")
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 DIS GE NKE SBUX
## 2013-01-31 -1.555890e-01 0.078945018 0.0596429085 0.0463884311 0.045383374
## 2013-02-28 -2.561089e-02 0.013091489 0.0494743236 0.0114287347 -0.019138946
## 2013-03-28 2.850280e-03 0.039685590 -0.0043162092 0.0802406473 0.037571455
## 2013-04-30 2.708685e-04 0.101055623 -0.0365596838 0.0749065640 0.066073821
## 2013-05-31 2.217162e-02 0.003811803 0.0451734190 -0.0276351868 0.040473541
## 2013-06-28 -1.258957e-01 0.001109092 0.0023642186 0.0322349116 0.036848510
## 2013-07-31 1.321023e-01 0.023475266 0.0496314071 -0.0120065240 0.084553277
## 2013-08-30 8.044293e-02 -0.060905046 -0.0517897063 0.0017288132 -0.008016812
## 2013-09-30 -2.172334e-02 0.058426991 0.0395694292 0.1452425954 0.087519466
## 2013-10-31 9.201510e-02 0.061636691 0.0900065446 0.0420547960 0.051650571
## 2013-11-29 6.770811e-02 0.028033184 0.0196977997 0.0436473777 0.008261319
## 2013-12-31 8.862524e-03 0.092072810 0.0581694097 -0.0032097280 -0.038416164
## 2014-01-31 -1.139495e-01 -0.050880166 -0.1092129518 -0.0764781317 -0.097327295
## 2014-02-28 5.591824e-02 0.106998182 0.0221381337 0.0752103942 0.001524771
## 2014-03-31 1.975650e-02 -0.009199418 0.0163556719 -0.0583755245 0.033534966
## 2014-04-30 9.476121e-02 -0.009159128 0.0378976585 -0.0123977515 -0.038338407
## 2014-05-30 7.576512e-02 0.057193608 -0.0037258300 0.0560132662 0.040101551
## 2014-06-30 2.728643e-02 0.020383730 -0.0110052927 0.0082872384 0.054986749
## 2014-07-31 2.832608e-02 0.001631331 -0.0439503121 -0.0054304497 0.003869249
## 2014-08-29 7.465183e-02 0.045524690 0.0324689966 0.0212576912 0.005031171
## 2014-09-30 -1.722098e-02 -0.009502099 -0.0055439151 0.1271460358 -0.030667359
## 2014-10-31 6.948912e-02 0.026053329 0.0073887917 0.0413956606 0.001324434
## 2014-11-28 1.007308e-01 0.012290174 0.0260050642 0.0657680257 0.076233481
## 2014-12-31 -7.460583e-02 0.030627126 -0.0377785598 -0.0292643194 0.010290687
## 2015-01-30 5.961108e-02 -0.034894382 -0.0561582821 -0.0414069646 0.064652893
## 2015-02-27 9.601638e-02 0.134740113 0.0934028762 0.0543411903 0.069516041
## 2015-03-31 -3.187455e-02 0.007752324 -0.0464649747 0.0325174896 0.012859196
## 2015-04-30 5.769742e-03 0.035863580 0.0875486234 -0.0149625033 0.046021080
## 2015-05-29 4.434131e-02 0.015062631 0.0069913801 0.0309562641 0.050063050
## 2015-06-30 -3.793804e-02 0.033587230 -0.0175340904 0.0605839170 0.031448023
## 2015-07-31 -3.348103e-02 0.055865262 -0.0178473617 0.0645269839 0.077313078
## 2015-08-31 -6.848906e-02 -0.163696104 -0.0502858494 -0.0305790442 -0.054435430
## 2015-09-30 -2.205757e-02 0.003136041 0.0248972209 0.0982089293 0.038193826
## 2015-10-30 8.011276e-02 0.106983437 0.1368961461 0.0634857734 0.096045555
## 2015-11-30 -5.821555e-03 -0.002376638 0.0346619242 0.0094946217 -0.015806174
## 2015-12-31 -1.167901e-01 -0.070426742 0.0470710090 -0.0541858786 -0.022402661
## 2016-01-29 -7.822362e-02 -0.092250517 -0.0680761569 -0.0078710268 0.012251803
## 2016-02-29 -1.288356e-03 -0.003135723 0.0093472994 -0.0067959980 -0.039776396
## 2016-03-31 1.197458e-01 0.038910574 0.0870397098 0.0006244367 0.025274516
## 2016-04-29 -1.507307e-01 0.039003730 -0.0332615759 -0.0420294088 -0.059881138
## 2016-05-31 6.931404e-02 -0.039910451 -0.0170550778 -0.0651946983 -0.020626689
## 2016-06-30 -4.359662e-02 -0.014210504 0.0480646685 0.0025550019 0.039823285
## 2016-07-29 8.623545e-02 -0.012063891 -0.0108593631 0.0054201519 0.016150504
## 2016-08-31 2.337665e-02 -0.015650730 0.0032061321 0.0378334873 -0.028378096
## 2016-09-30 6.344806e-02 -0.017083513 -0.0454752143 -0.0877707461 -0.037876773
## 2016-10-31 4.324792e-03 -0.001832414 -0.0177116425 -0.0480495492 -0.019961700
## 2016-11-30 -2.183742e-02 0.067070708 0.0554770362 -0.0021946334 0.092935262
## 2016-12-30 4.684081e-02 0.057850003 0.0344397088 0.0186660345 -0.043182452
## 2017-01-31 4.664172e-02 0.059868044 -0.0620100956 0.0399166800 -0.005417925
## 2017-02-28 1.255552e-01 -0.005073880 0.0116413592 0.0774510067 0.033938572
## 2017-03-31 4.754174e-02 0.029534937 -0.0003357191 -0.0222246585 0.026376944
## 2017-04-28 -7.011645e-05 0.019302752 -0.0275571859 -0.0057583519 0.028199374
## 2017-05-31 6.560768e-02 -0.068560385 -0.0571383212 -0.0446569378 0.061537374
## 2017-06-30 -5.891598e-02 -0.015780704 -0.0052051729 0.1108367799 -0.086997169
## 2017-07-31 3.218042e-02 0.041460572 -0.0532238991 0.0008470136 -0.077159785
## 2017-08-31 1.016530e-01 -0.082745065 -0.0422716625 -0.1082534116 0.020674754
## 2017-09-29 -6.213503e-02 -0.026331723 -0.0052433510 -0.0183455428 -0.021185125
## 2017-10-31 9.240389e-02 -0.007740157 -0.1818256969 0.0587962061 0.020820699
## 2017-11-30 2.007547e-02 0.069217838 -0.0973458739 0.0941688018 0.058198315
## 2017-12-29 -1.536345e-02 0.033351518 -0.0401342315 0.0379616525 -0.006767588
# Covariance of asset returns
covariance_matrix <- cov(asset_returns_wide_tbl)
covariance_matrix
## AAPL DIS GE NKE SBUX
## AAPL 0.0048301427 0.0005731142 0.0004919204 0.0001480962 0.0009229602
## DIS 0.0005731142 0.0027865607 0.0012309843 0.0014067503 0.0009090428
## GE 0.0004919204 0.0012309843 0.0029610678 0.0004404500 0.0007546582
## NKE 0.0001480962 0.0014067503 0.0004404500 0.0028217770 0.0007270422
## SBUX 0.0009229602 0.0009090428 0.0007546582 0.0007270422 0.0020932740
# 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.0362465
# 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
## AAPL DIS GE NKE SBUX
## [1,] 0.01083631 0.01005869 0.006546814 0.006146034 0.002658652
rowSums(component_contribution)
## [1] 0.0362465
# Component contribution in percentage
component_percentages <- (component_contribution / sd_portfolio[1,1]) %>%
round(3) %>%
as_tibble()
component_percentages
## # A tibble: 1 × 5
## AAPL DIS GE NKE SBUX
## <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 0.299 0.278 0.181 0.17 0.073
component_percentages %>%
as_tibble() %>%
gather(key = "asset", value = "contribution")
## # A tibble: 5 × 2
## asset contribution
## <chr> <dbl>
## 1 AAPL 0.299
## 2 DIS 0.278
## 3 GE 0.181
## 4 NKE 0.17
## 5 SBUX 0.073
# 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 DIS GE NKE SBUX
## 2013-01-31 -1.555890e-01 0.078945018 0.0596429085 0.0463884311 0.045383374
## 2013-02-28 -2.561089e-02 0.013091489 0.0494743236 0.0114287347 -0.019138946
## 2013-03-28 2.850280e-03 0.039685590 -0.0043162092 0.0802406473 0.037571455
## 2013-04-30 2.708685e-04 0.101055623 -0.0365596838 0.0749065640 0.066073821
## 2013-05-31 2.217162e-02 0.003811803 0.0451734190 -0.0276351868 0.040473541
## 2013-06-28 -1.258957e-01 0.001109092 0.0023642186 0.0322349116 0.036848510
## 2013-07-31 1.321023e-01 0.023475266 0.0496314071 -0.0120065240 0.084553277
## 2013-08-30 8.044293e-02 -0.060905046 -0.0517897063 0.0017288132 -0.008016812
## 2013-09-30 -2.172334e-02 0.058426991 0.0395694292 0.1452425954 0.087519466
## 2013-10-31 9.201510e-02 0.061636691 0.0900065446 0.0420547960 0.051650571
## 2013-11-29 6.770811e-02 0.028033184 0.0196977997 0.0436473777 0.008261319
## 2013-12-31 8.862524e-03 0.092072810 0.0581694097 -0.0032097280 -0.038416164
## 2014-01-31 -1.139495e-01 -0.050880166 -0.1092129518 -0.0764781317 -0.097327295
## 2014-02-28 5.591824e-02 0.106998182 0.0221381337 0.0752103942 0.001524771
## 2014-03-31 1.975650e-02 -0.009199418 0.0163556719 -0.0583755245 0.033534966
## 2014-04-30 9.476121e-02 -0.009159128 0.0378976585 -0.0123977515 -0.038338407
## 2014-05-30 7.576512e-02 0.057193608 -0.0037258300 0.0560132662 0.040101551
## 2014-06-30 2.728643e-02 0.020383730 -0.0110052927 0.0082872384 0.054986749
## 2014-07-31 2.832608e-02 0.001631331 -0.0439503121 -0.0054304497 0.003869249
## 2014-08-29 7.465183e-02 0.045524690 0.0324689966 0.0212576912 0.005031171
## 2014-09-30 -1.722098e-02 -0.009502099 -0.0055439151 0.1271460358 -0.030667359
## 2014-10-31 6.948912e-02 0.026053329 0.0073887917 0.0413956606 0.001324434
## 2014-11-28 1.007308e-01 0.012290174 0.0260050642 0.0657680257 0.076233481
## 2014-12-31 -7.460583e-02 0.030627126 -0.0377785598 -0.0292643194 0.010290687
## 2015-01-30 5.961108e-02 -0.034894382 -0.0561582821 -0.0414069646 0.064652893
## 2015-02-27 9.601638e-02 0.134740113 0.0934028762 0.0543411903 0.069516041
## 2015-03-31 -3.187455e-02 0.007752324 -0.0464649747 0.0325174896 0.012859196
## 2015-04-30 5.769742e-03 0.035863580 0.0875486234 -0.0149625033 0.046021080
## 2015-05-29 4.434131e-02 0.015062631 0.0069913801 0.0309562641 0.050063050
## 2015-06-30 -3.793804e-02 0.033587230 -0.0175340904 0.0605839170 0.031448023
## 2015-07-31 -3.348103e-02 0.055865262 -0.0178473617 0.0645269839 0.077313078
## 2015-08-31 -6.848906e-02 -0.163696104 -0.0502858494 -0.0305790442 -0.054435430
## 2015-09-30 -2.205757e-02 0.003136041 0.0248972209 0.0982089293 0.038193826
## 2015-10-30 8.011276e-02 0.106983437 0.1368961461 0.0634857734 0.096045555
## 2015-11-30 -5.821555e-03 -0.002376638 0.0346619242 0.0094946217 -0.015806174
## 2015-12-31 -1.167901e-01 -0.070426742 0.0470710090 -0.0541858786 -0.022402661
## 2016-01-29 -7.822362e-02 -0.092250517 -0.0680761569 -0.0078710268 0.012251803
## 2016-02-29 -1.288356e-03 -0.003135723 0.0093472994 -0.0067959980 -0.039776396
## 2016-03-31 1.197458e-01 0.038910574 0.0870397098 0.0006244367 0.025274516
## 2016-04-29 -1.507307e-01 0.039003730 -0.0332615759 -0.0420294088 -0.059881138
## 2016-05-31 6.931404e-02 -0.039910451 -0.0170550778 -0.0651946983 -0.020626689
## 2016-06-30 -4.359662e-02 -0.014210504 0.0480646685 0.0025550019 0.039823285
## 2016-07-29 8.623545e-02 -0.012063891 -0.0108593631 0.0054201519 0.016150504
## 2016-08-31 2.337665e-02 -0.015650730 0.0032061321 0.0378334873 -0.028378096
## 2016-09-30 6.344806e-02 -0.017083513 -0.0454752143 -0.0877707461 -0.037876773
## 2016-10-31 4.324792e-03 -0.001832414 -0.0177116425 -0.0480495492 -0.019961700
## 2016-11-30 -2.183742e-02 0.067070708 0.0554770362 -0.0021946334 0.092935262
## 2016-12-30 4.684081e-02 0.057850003 0.0344397088 0.0186660345 -0.043182452
## 2017-01-31 4.664172e-02 0.059868044 -0.0620100956 0.0399166800 -0.005417925
## 2017-02-28 1.255552e-01 -0.005073880 0.0116413592 0.0774510067 0.033938572
## 2017-03-31 4.754174e-02 0.029534937 -0.0003357191 -0.0222246585 0.026376944
## 2017-04-28 -7.011645e-05 0.019302752 -0.0275571859 -0.0057583519 0.028199374
## 2017-05-31 6.560768e-02 -0.068560385 -0.0571383212 -0.0446569378 0.061537374
## 2017-06-30 -5.891598e-02 -0.015780704 -0.0052051729 0.1108367799 -0.086997169
## 2017-07-31 3.218042e-02 0.041460572 -0.0532238991 0.0008470136 -0.077159785
## 2017-08-31 1.016530e-01 -0.082745065 -0.0422716625 -0.1082534116 0.020674754
## 2017-09-29 -6.213503e-02 -0.026331723 -0.0052433510 -0.0183455428 -0.021185125
## 2017-10-31 9.240389e-02 -0.007740157 -0.1818256969 0.0587962061 0.020820699
## 2017-11-30 2.007547e-02 0.069217838 -0.0973458739 0.0941688018 0.058198315
## 2017-12-29 -1.536345e-02 0.033351518 -0.0401342315 0.0379616525 -0.006767588
cal_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 %>% cal_component_contribution(w = c(.25, .25, .2, .2, .1 ))
## # A tibble: 1 × 5
## AAPL DIS GE NKE SBUX
## <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 0.299 0.278 0.181 0.17 0.073
Column Chart of Component Contribution
plot_data <- asset_returns_wide_tbl %>%
cal_component_contribution(w = c(.25, .25, .2, .2, .1 )) %>%
# Transform to long from
pivot_longer(cols = everything(), names_to = "Asset", values_to = "Contribution")
plot_data %>%
ggplot(aes(x = Asset, y = Contribution)) +
geom_col(fill = "cornflowerblue") +
scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
theme(plot.title = element_text(hjust = 0.5)) +
labs(title = "Percent Contribution to Portfolio Volatility")
plot_data <- asset_returns_wide_tbl %>%
cal_component_contribution(w = c(.25, .25, .2, .2, .1 )) %>%
# Transform to long from
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_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?
Apple is my stock with the largest contribution to the portfolio volatility,however Disney and Starbucks do not fall far behind in terms of high contribution and volatility. My portfolio is diversified and does not seem to be concentrated in one asset.