Week 14: Apply 12
Eoin Hamell-Kelleher
2023-05-9
# 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
symbols <- c("NKE", "MSFT", "GOOG", "TSLA", "AMZN")
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## AMZN GOOG MSFT NKE TSLA
## 2013-01-31 0.0566799640 0.066063183 0.027328277 0.0463883017 0.102078031
## 2013-02-28 -0.0046435329 0.058479349 0.020915050 0.0114289611 -0.074128613
## 2013-03-28 0.0083654117 -0.008787848 0.028720295 0.0802403050 0.084208141
## 2013-04-30 -0.0487507638 0.037539320 0.145776986 0.0749064104 0.354111527
## 2013-05-31 0.0588686422 0.055032448 0.059941068 -0.0276352997 0.593716693
## 2013-06-28 0.0310507858 0.010447756 -0.010368778 0.0322349473 0.093672182
## 2013-07-31 0.0813355112 0.008347897 -0.081394397 -0.0120064868 0.223739545
## 2013-08-30 -0.0695574024 -0.047107484 0.054854343 0.0017288037 0.229971572
## 2013-09-30 0.1067688764 0.033680642 -0.003599367 0.1452421943 0.134706682
## 2013-10-31 0.1521839130 0.162613748 0.062037340 0.0420550503 -0.189806650
## 2013-11-29 0.0781496951 0.027760300 0.081562724 0.0436481038 -0.228409431
## 2013-12-31 0.0130490358 0.056080333 -0.019063379 -0.0032101363 0.167108548
## 2014-01-31 -0.1059765070 0.052373779 0.011428753 -0.0764778226 0.187261770
## 2014-02-28 0.0094619111 0.028942731 0.019815082 0.0752105396 0.299722757
## 2014-03-31 -0.0737086127 -0.086376126 0.067616940 -0.0583764875 -0.160783192
## 2014-04-30 -0.1007565625 -0.055956216 -0.014498138 -0.0123968514 -0.002690159
## 2014-05-30 0.0273092148 0.061185200 0.020307481 0.0560128329 -0.000577395
## 2014-06-30 0.0383835737 0.027116573 0.018393742 0.0082872339 0.144457218
## 2014-07-31 -0.0369767889 -0.006417530 0.034412912 -0.0054306231 -0.072372711
## 2014-08-29 0.0799468534 0.000000000 0.057485051 0.0212579490 0.188794049
## 2014-09-30 -0.0502010221 0.010026597 0.020264076 0.1271459124 -0.105566506
## 2014-10-31 -0.0540982353 -0.032173432 0.012646455 0.0413956964 -0.004046457
## 2014-11-28 0.1031187000 -0.031340259 0.024438910 0.0657678506 0.011599756
## 2014-12-31 -0.0872368443 -0.028890933 -0.028858133 -0.0292639544 -0.094774520
## 2015-01-30 0.1330922758 0.015307754 -0.139547014 -0.0414070791 -0.088365243
## 2015-02-27 0.0697991955 0.043706410 0.089036319 0.0543410026 -0.001277805
## 2015-03-31 -0.0214295288 -0.018800219 -0.075529508 0.0325174665 -0.074350086
## 2015-04-30 0.1253212631 -0.016902497 0.179201084 -0.0149625708 0.180226844
## 2015-05-29 0.0175090073 -0.009780881 -0.030803957 0.0309566095 0.103899535
## 2015-06-30 0.0112589801 -0.022041136 -0.059571131 0.0605840251 0.067300966
## 2015-07-31 0.2111621241 0.183918112 0.056151123 0.0645270979 -0.007896618
## 2015-08-31 -0.0443525737 -0.011834267 -0.063950893 -0.0305794124 -0.066366266
## 2015-09-30 -0.0019516780 -0.016027473 0.016860468 0.0982087929 -0.002653542
## 2015-10-30 0.2010808557 0.155539760 0.173395111 0.0634861098 -0.182659742
## 2015-11-30 0.0602956898 0.043752376 0.038686218 0.0094946595 0.106828579
## 2015-12-31 0.0165439780 0.021686093 0.020578074 -0.0541863079 0.041471546
## 2016-01-29 -0.1410054619 -0.021214941 -0.007054663 -0.0078707491 -0.227360646
## 2016-02-29 -0.0605352242 -0.062739185 -0.072343945 -0.0067962168 0.003810669
## 2016-03-31 0.0717834457 0.065427593 0.082036266 0.0006245188 0.179948112
## 2016-04-29 0.1053453885 -0.072272671 -0.102086790 -0.0420288113 0.046721799
## 2016-05-31 0.0915002937 0.059805126 0.067842410 -0.0651950656 -0.075597977
## 2016-06-30 -0.0099694796 -0.061119131 -0.035138500 0.0025547583 -0.050296472
## 2016-07-29 0.0586021200 0.105087370 0.102268202 0.0054200146 0.100785361
## 2016-08-31 0.0135476463 -0.002265810 0.019880687 0.0378337649 -0.102058076
## 2016-09-30 0.0848953859 0.013261445 0.002433606 -0.0877707138 -0.038366402
## 2016-10-31 -0.0583892995 0.009284125 0.039487771 -0.0480495757 -0.031364578
## 2016-11-30 -0.0509721788 -0.034361430 0.012390768 -0.0021945446 -0.043041257
## 2016-12-30 -0.0009330597 0.018015208 0.030721634 0.0186660982 0.120665160
## 2017-01-31 0.0936394046 0.031839794 0.039598117 0.0399166113 0.164624944
## 2017-02-28 0.0258446771 0.032620176 -0.004373208 0.0774508422 -0.007730394
## 2017-03-31 0.0479423059 0.007684132 0.028960692 -0.0222248142 0.107278734
## 2017-04-28 0.0424566809 0.088099691 0.038718460 -0.0057585001 0.120916240
## 2017-05-31 0.0725778079 0.062987858 0.025672805 -0.0446567770 0.082295867
## 2017-06-30 -0.0271286060 -0.059934971 -0.013115737 0.1108369772 0.058654469
## 2017-07-31 0.0202278723 0.023674077 0.053250283 0.0008469698 -0.111459838
## 2017-08-31 -0.0072953921 0.009444715 0.033388989 -0.1082532315 0.095543417
## 2017-09-29 -0.0198260414 0.020838979 -0.003751688 -0.0183459146 -0.042474117
## 2017-10-31 0.1395154081 0.058252558 0.110341585 0.0587964431 -0.028457431
## 2017-11-30 0.0626577388 0.004680914 0.016841215 0.0941688267 -0.070862536
## 2017-12-29 -0.0062057977 0.024171696 0.016145829 0.0379617474 0.008061927covariance_matrix <- cov(asset_returns_wide_tbl)
covariance_matrix## AMZN GOOG MSFT NKE TSLA
## AMZN 0.0054660217 0.0023733615 0.0012207210 0.0007202259 0.0005128767
## GOOG 0.0023733615 0.0028612905 0.0014481465 0.0003704537 0.0004123950
## MSFT 0.0012207210 0.0014481465 0.0034652264 0.0004282569 0.0009885666
## NKE 0.0007202259 0.0003704537 0.0004282569 0.0028217772 -0.0001432291
## TSLA 0.0005128767 0.0004123950 0.0009885666 -0.0001432291 0.0209573545w <- c(0.20, 0.30, 0.10, 0.2, 0.2)
sd_portfolio <- sqrt(t(w) %*% covariance_matrix %*% w)
sd_portfolio## [,1]
## [1,] 0.04604672component_contribution <- (t(w) %*% covariance_matrix * w) / sd_portfolio[1,1]
component_contribution## AMZN GOOG MSFT NKE TSLA
## [1,] 0.009442173 0.0106486 0.002841626 0.003621177 0.01949314rowSums(component_contribution)## [1] 0.04604672component_percentages <- (component_contribution / sd_portfolio[1,1]) %>%
round(3) %>%
as_tibble()
component_percentages## # A tibble: 1 × 5
## AMZN GOOG MSFT NKE TSLA
## <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 0.205 0.231 0.062 0.079 0.423component_percentages %>%
as_tibble() %>%
gather(key = "asset", value = "contribution")## # A tibble: 5 × 2
## asset contribution
## <chr> <dbl>
## 1 AMZN 0.205
## 2 GOOG 0.231
## 3 MSFT 0.062
## 4 NKE 0.079
## 5 TSLA 0.423asset_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.2,0.3,0.1,0.2,0.2))## # A tibble: 1 × 5
## AMZN GOOG MSFT NKE TSLA
## <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 0.205 0.231 0.062 0.079 0.423asset_returns_wide_tbl %>%
calculate_component_contribution(w = c(0.2,0.3,0.1,0.2,0.2)) %>%
gather(key = "asset", value = "contribution") %>%
ggplot(aes(asset, contribution)) +
geom_col(fill = "cornflowerblue") +
theme(plot.title = element_text(hjust = 0.5)) +
scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
labs(title = "Percent Contribution to Portfolio Standard Deviation",
y = "Percent Contribution to Risk",
x = NULL)
asset_returns_wide_tbl %>%
calculate_component_contribution(w = c(0.2,0.3,0.1,0.2,0.2)) %>%
gather(key = "asset", value = "contribution") %>%
add_column(weights = c(0.2,0.3,0.1,0.2,0.2)) %>%
pivot_longer(cols = c(contribution, weights), names_to = "type", values_to = "value") %>%
ggplot(aes(asset, value, fill = type)) +
geom_col(position = "dodge") +
theme(plot.title = element_text(hjust = 0.5)) +
scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
theme_tq() +
scale_fill_tq() +
labs(title = "Percent Contribution to Volatility",
y = "percent",
x = "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.2,0.3,0.1,0.2,0.2))## # A tibble: 1 × 6
## date AMZN GOOG MSFT NKE TSLA
## <date> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 2015-01-30 0.161 0.176 0.017 0.072 0.574asset_returns_wide_tbl %>% calculate_comp_contrib_by_window(start = 2, window = 24,
w = c(0.2,0.3,0.1,0.2,0.2))## # A tibble: 1 × 6
## date AMZN GOOG MSFT NKE TSLA
## <date> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 2015-02-27 0.14 0.167 0.027 0.078 0.589w <- c(0.2,0.3,0.1,0.2,0.2)
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 AMZN GOOG MSFT NKE TSLA
## <date> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 2015-01-30 0.161 0.176 0.017 0.072 0.574
## 2 2015-02-27 0.14 0.167 0.027 0.078 0.589
## 3 2015-03-31 0.142 0.175 0.029 0.079 0.576
## 4 2015-04-30 0.142 0.176 0.035 0.073 0.574
## 5 2015-05-29 0.184 0.171 0.034 0.058 0.554
## 6 2015-06-30 0.227 0.192 0.033 0.106 0.443
## 7 2015-07-31 0.227 0.193 0.035 0.105 0.441
## 8 2015-08-31 0.254 0.259 0.043 0.108 0.336
## 9 2015-09-30 0.254 0.252 0.048 0.113 0.332
## 10 2015-10-30 0.255 0.269 0.055 0.09 0.33
## # … with 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("TSLA changes rapidly, indicating
it increases the portfolio volatility."))
6 Plot: Colum Chart of Component Contribution and Weight
rolling_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("TSLA changes rapidly, indicating
it increases the portfolio volatility."))
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("TSLA changes rapidly, indicating
it increases the portfolio volatility"))
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?
TSLA is the largest contributer to the portfolios volatility, as you can see it take a massive dip only over a few years and the increase within a year span. My portfolios risk is concentrated within TSLA.