Apply it to your data 12
Which of the assets the largest contributor to the portfolio volatility?
Daniel Lee
2022-09-19
# Load packages
# Core
library(tidyverse)
library(tidyquant)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
Choose your stocks from 2012-12-31 to present.
symbols <- c("AAPL", "TSLA", "NFLX", "MTN", "DIS")
prices <- tq_get(x = symbols,
get = "stock.prices",
from = "2012-12-31",
to = "2017-12-31")2 Convert prices to returns (monthly)
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"))3 Calculate Component Contribution to Portfolio Volatility
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 MTN NFLX TSLA
## 2013-01-31 -1.555892e-01 0.078945343 -0.0231918724 0.579217807 0.102078114
## 2013-02-28 -2.561112e-02 0.013091424 0.0442297378 0.129468379 -0.074128640
## 2013-03-28 2.850342e-03 0.039685715 0.1239325401 0.006360071 0.084208138
## 2013-04-30 2.710681e-04 0.101055590 -0.0329506326 0.132375020 0.354111531
## 2013-05-31 2.217210e-02 0.003811641 0.0603319018 0.046038179 0.593716684
## 2013-06-28 -1.258960e-01 0.001109263 -0.0370411874 -0.069356059 0.093672163
## 2013-07-31 1.321022e-01 0.023475036 0.0850321341 0.146848883 0.223739522
## 2013-08-30 8.044283e-02 -0.060904939 0.0151132706 0.149523815 0.229971642
## 2013-09-30 -2.172321e-02 0.058427054 0.0200911441 0.085363345 0.134706620
## 2013-10-31 9.201521e-02 0.061636785 0.0183269115 0.042020452 -0.189806595
## 2013-11-29 6.770803e-02 0.028033167 0.0730628028 0.126045633 -0.228409405
## 2013-12-31 8.862431e-03 0.092072694 -0.0046405259 0.006458091 0.167108541
## 2014-01-31 -1.139495e-01 -0.050879802 -0.0988388515 0.105976906 0.187261714
## 2014-02-28 5.591824e-02 0.106997830 0.0313453514 0.084967340 0.299722785
## 2014-03-31 1.975631e-02 -0.009199477 -0.0028627076 -0.235772622 -0.160783242
## 2014-04-30 9.476113e-02 -0.009158724 -0.0067660048 -0.089040653 -0.002690122
## 2014-05-30 7.576526e-02 0.057193347 0.0066226754 0.260398864 -0.000577422
## 2014-06-30 2.728649e-02 0.020383646 0.1075734020 0.053062785 0.144457224
## 2014-07-31 2.832618e-02 0.001631637 -0.0220076250 -0.041427371 -0.072372676
## 2014-08-29 7.465184e-02 0.045524219 0.0514985456 0.122147235 0.188794007
## 2014-09-30 -1.722096e-02 -0.009502046 0.0875144905 -0.056990921 -0.105566477
## 2014-10-31 6.948911e-02 0.026053373 0.0002988081 -0.138642147 -0.004046477
## 2014-11-28 1.007308e-01 0.012290061 0.0147128915 -0.125081717 0.011599801
## 2014-12-31 -7.460609e-02 0.030627226 0.0436537363 -0.014472733 -0.094774519
## 2015-01-30 5.961153e-02 -0.034894290 -0.0376810830 0.257187512 -0.088365289
## 2015-02-27 9.601606e-02 0.134740106 0.0005695887 0.072268016 -0.001277808
## 2015-03-31 -3.187436e-02 0.007752275 0.1699390530 -0.130782770 -0.074350051
## 2015-04-30 5.769568e-03 0.035863546 -0.0415595895 0.289324652 0.180226808
## 2015-05-29 4.434121e-02 0.015062589 0.0446488031 0.114579343 0.103899574
## 2015-06-30 -3.793802e-02 0.033587462 0.0569933105 0.051346180 0.067300935
## 2015-07-31 -3.348100e-02 0.055865152 0.0044771246 0.197231490 -0.007896616
## 2015-08-31 -6.848885e-02 -0.163696244 -0.0163607695 0.006278919 -0.066366250
## 2015-09-30 -2.205779e-02 0.003136098 -0.0303893068 -0.107942853 -0.002653519
## 2015-10-30 8.011263e-02 0.106983559 0.0927711646 0.048393445 -0.182659777
## 2015-11-30 -5.821329e-03 -0.002376683 0.0547906642 0.129220160 0.106828586
## 2015-12-31 -1.167903e-01 -0.070426735 0.0644606296 -0.075337490 0.041471519
## 2016-01-29 -7.822376e-02 -0.092250540 -0.0236383431 -0.219478322 -0.227360626
## 2016-02-29 -1.288089e-03 -0.003135750 0.0190963881 0.016950552 0.003810669
## 2016-03-31 1.197460e-01 0.038910635 0.0546075157 0.090226765 0.179948109
## 2016-04-29 -1.507308e-01 0.039003695 -0.0308369548 -0.127082275 0.046721797
## 2016-05-31 6.931422e-02 -0.039910424 0.0123425492 0.130402555 -0.075597968
## 2016-06-30 -4.359686e-02 -0.014210490 0.0575821650 -0.114425083 -0.050296440
## 2016-07-29 8.623558e-02 -0.012063988 0.0344152620 -0.002517413 0.100785334
## 2016-08-31 2.337629e-02 -0.015650851 0.1019784574 0.065736402 -0.102058091
## 2016-09-30 6.344843e-02 -0.017083223 -0.0098317846 0.011224670 -0.038366372
## 2016-10-31 4.324929e-03 -0.001832563 0.0213716193 0.236709154 -0.031364583
## 2016-11-30 -2.183771e-02 0.067070612 -0.0065441011 -0.065099283 -0.043041267
## 2016-12-30 4.684044e-02 0.057850108 0.0231786958 0.056493450 0.120665178
## 2017-01-31 4.664191e-02 0.059868052 0.0614884585 0.128033698 0.164624916
## 2017-02-28 1.255554e-01 -0.005073886 0.0546744400 0.010041084 -0.007730364
## 2017-03-31 4.754166e-02 0.029534975 0.0631143976 0.039185483 0.107278727
## 2017-04-28 -6.988896e-05 0.019302741 0.0295740196 0.029267777 0.120916212
## 2017-05-31 6.560722e-02 -0.068560258 0.0789604501 0.068984176 0.082295892
## 2017-06-30 -5.891597e-02 -0.015780857 -0.0481440735 -0.087485372 0.058654468
## 2017-07-31 3.218079e-02 0.041460580 0.0383517328 0.195442599 -0.111459860
## 2017-08-31 1.016528e-01 -0.082745077 0.0784062317 -0.039009333 0.095543446
## 2017-09-29 -6.213463e-02 -0.026331693 0.0007453902 0.037301404 -0.042474144
## 2017-10-31 9.240361e-02 -0.007740164 0.0088134673 0.079877197 -0.028457409
## 2017-11-30 2.007518e-02 0.069217765 -0.0169978733 -0.046100666 -0.070862541
## 2017-12-29 -1.536360e-02 0.033351510 -0.0531049851 0.023081621 0.008061928covariance_matrix <- cov(asset_returns_wide_tbl)
covariance_matrix## AAPL DIS MTN NFLX TSLA
## AAPL 0.0048301465 5.731109e-04 1.066263e-03 0.0006512443 4.839080e-04
## DIS 0.0005731109 2.786559e-03 8.463741e-05 0.0019003221 1.349722e-03
## MTN 0.0010662635 8.463741e-05 2.427744e-03 -0.0003491263 -3.105694e-05
## NFLX 0.0006512443 1.900322e-03 -3.491263e-04 0.0177864943 4.989080e-03
## TSLA 0.0004839080 1.349722e-03 -3.105694e-05 0.0049890797 2.095735e-02w <- c(0.25, 0.25, 0.2, 0.2, 0.1)
sd_portfolio <- sqrt(t(w) %*% covariance_matrix %*% w)
sd_portfolio## [,1]
## [1,] 0.04688438component_contribution <- (t(w) %*% covariance_matrix * w) / sd_portfolio[1,1]
component_contribution## AAPL DIS MTN NFLX TSLA
## [1,] 0.009292576 0.007315237 0.002987533 0.01972629 0.007562748rowSums(component_contribution)## [1] 0.04688438component_percentages <- (component_contribution / sd_portfolio[1,1]) %>%
round(3) %>%
as_tibble()
component_percentages## # A tibble: 1 × 5
## AAPL DIS MTN NFLX TSLA
## <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 0.198 0.156 0.064 0.421 0.161component_percentages %>%
as_tibble() %>%
gather(key = "asset", value = "contribution")## # A tibble: 5 × 2
## asset contribution
## <chr> <dbl>
## 1 AAPL 0.198
## 2 DIS 0.156
## 3 MTN 0.064
## 4 NFLX 0.421
## 5 TSLA 0.161asset_returns_wide_tbl <- asset_returns_tbl %>%
pivot_wider(names_from = asset, values_from = returns) %>%
column_to_rownames(var = "date")
calculate_component_contribution <- function(asset_returns_wide_tbl, w) {
covariance_matrix <- cov(asset_returns_wide_tbl)
sd_portfolio <- sqrt(t(w) %*% covariance_matrix %*% w)
component_contribution <- (t(w) %*% covariance_matrix * w) / sd_portfolio[1,1]
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.25,0.25,0.2,0.2,0.1))## # A tibble: 1 × 5
## AAPL DIS MTN NFLX TSLA
## <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 0.198 0.156 0.064 0.421 0.1616 Plot: Colum Chart of Component Contribution and Weight
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?
calculate_comp_contrib_by_window <- function(asset_returns_wide_tbl,
start = 1,
window = 24,
weights) {
start_date <- rownames(asset_returns_wide_tbl)[start]
end_date <- rownames(asset_returns_wide_tbl)[start + window]
df_subset <- asset_returns_wide_tbl %>%
rownames_to_column(var = "date") %>%
filter(date >= start_date & date < end_date) %>%
column_to_rownames(var = "date")
component_percentages <-df_subset %>%
calculate_component_contribution(w = weights)
component_percentages %>%
mutate(date = ymd(end_date)) %>%
select(date, everything())
}
asset_returns_wide_tbl %>% calculate_comp_contrib_by_window(start = 1, window = 24,
w = c(0.25,0.25,0.2,0.2,0.1))## # A tibble: 1 × 6
## date AAPL DIS MTN NFLX TSLA
## <date> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 2015-01-30 0.108 0.118 0.07 0.477 0.227asset_returns_wide_tbl %>% calculate_comp_contrib_by_window(start = 2, window = 24,
w = c(0.25,0.25,0.2,0.2,0.1))## # A tibble: 1 × 6
## date AAPL DIS MTN NFLX TSLA
## <date> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 2015-02-27 0.183 0.108 0.088 0.379 0.242dump(list = c("calculate_component_contribution",
"calculate_comp_contrib_by_window"),
file = "../00_scripts/calculate_comp_contrib_to_portfolio_volatility.R")w <- c(0.25,0.25,0.2,0.2,0.1)
window <- 24
rolling_comp_contrib_tbl <- 1:(nrow(asset_returns_wide_tbl) - window) %>%
map_df(.x = ., .f = ~calculate_comp_contrib_by_window(asset_returns_wide_tbl,
start = .x,
weights = w,
window = window))
rolling_comp_contrib_tbl## # A tibble: 36 × 6
## date AAPL DIS MTN NFLX TSLA
## <date> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 2015-01-30 0.108 0.118 0.07 0.477 0.227
## 2 2015-02-27 0.183 0.108 0.088 0.379 0.242
## 3 2015-03-31 0.188 0.126 0.083 0.377 0.227
## 4 2015-04-30 0.197 0.126 0.054 0.393 0.231
## 5 2015-05-29 0.199 0.111 0.053 0.422 0.215
## 6 2015-06-30 0.213 0.121 0.049 0.45 0.167
## 7 2015-07-31 0.174 0.126 0.034 0.469 0.197
## 8 2015-08-31 0.144 0.148 0.013 0.508 0.187
## 9 2015-09-30 0.157 0.236 0.027 0.422 0.158
## 10 2015-10-30 0.165 0.224 0.038 0.428 0.146
## # ℹ 26 more rowsrolling_comp_contrib_tbl %>%
pivot_longer(cols = -date, names_to = "asset", values_to = "contribution") %>%
ggplot(aes(date, contribution, color = asset)) +
geom_line() +
scale_x_date(breaks = scales::pretty_breaks(n = 7)) +
scale_y_continuous(labels = scales::percent_format()) +
annotate(geom = "text",
x = as.Date("2016-07-01"),
y = 0.03,
color = "red", size = 5,
label = str_glue())
rolling_comp_contrib_tbl %>%
pivot_longer(cols = -date, names_to = "asset", values_to = "contribution") %>%
ggplot(aes(date, contribution, fill = asset)) +
geom_area() +
scale_x_date(breaks = scales::pretty_breaks(n = 7)) +
scale_y_continuous(labels = scales::percent_format()) +
annotate(geom = "text",
x = as.Date("2016-07-01"),
y = 0.08,
color = "red", size = 5,
label = str_glue())