Data Anlytics Example
Eoin Hamell-Kelleher
2023-05-09
# Load packages
# Core
library(tidyverse)
library(tidyquant)
library(readr)
# Time series
library(lubridate)
library(tibbletime)
# modeling
library(broom)five stocks: “SPY”, “EFA”, “IJS”, “EEM”, “AGG” from 2012-12-31 to 2017-12-31
1 Import stock prices
symbols <- c("SPY", "EFA", "IJS", "EEM", "AGG")
prices <- tq_get(x = symbols,
get = "stock.prices",
from = "2012-12-31",
to = "2017-12-31")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"))3 Component Contribution Step-by-Step
asset_returns_wide_tbl <- asset_returns_tbl %>%
pivot_wider(names_from = asset, values_from = returns) %>%
column_to_rownames(var = "date")
asset_returns_wide_tbl## AGG EEM EFA IJS SPY
## 2013-01-31 -0.0062304957 -0.0029354002 0.0366062437 0.052133346 4.992309e-02
## 2013-02-28 0.0058910384 -0.0231053976 -0.0129692994 0.016175207 1.267776e-02
## 2013-03-28 0.0009845487 -0.0102349970 0.0129692994 0.040258319 3.726808e-02
## 2013-04-30 0.0096392270 0.0120846536 0.0489678648 0.001222398 1.903008e-02
## 2013-05-31 -0.0202137015 -0.0494835199 -0.0306556320 0.041976316 2.333507e-02
## 2013-06-28 -0.0157784052 -0.0547283642 -0.0271444777 -0.001402621 -1.343376e-02
## 2013-07-31 0.0026872334 0.0131600965 0.0518601924 0.063541116 5.038580e-02
## 2013-08-30 -0.0082977690 -0.0257059690 -0.0197462997 -0.034743456 -3.045156e-02
## 2013-09-30 0.0111439062 0.0695889220 0.0753385893 0.063873520 3.115595e-02
## 2013-10-31 0.0082923462 0.0408611695 0.0320816277 0.034234244 4.526678e-02
## 2013-11-29 -0.0025101548 -0.0025937560 0.0054496192 0.041661098 2.920686e-02
## 2013-12-31 -0.0055826560 -0.0040744160 0.0215281500 0.012891750 2.559621e-02
## 2014-01-31 0.0152913261 -0.0903229605 -0.0534131976 -0.035774896 -3.588464e-02
## 2014-02-28 0.0037564166 0.0332207795 0.0595049505 0.045257335 4.451041e-02
## 2014-03-31 -0.0014810703 0.0380215361 -0.0046027573 0.013315075 8.261211e-03
## 2014-04-30 0.0081831072 0.0077730029 0.0165295746 -0.023183889 6.927369e-03
## 2014-05-30 0.0117214763 0.0290909599 0.0158284266 0.006205136 2.294165e-02
## 2014-06-30 -0.0005756434 0.0237340696 0.0091652855 0.037718645 2.043418e-02
## 2014-07-31 -0.0025120344 0.0135557663 -0.0263797870 -0.052009316 -1.352851e-02
## 2014-08-29 0.0114309902 0.0279044895 0.0018005893 0.043657743 3.870455e-02
## 2014-09-30 -0.0061677713 -0.0808567758 -0.0395984554 -0.061260385 -1.389245e-02
## 2014-10-31 0.0105847291 0.0140965399 -0.0026547925 0.068875004 2.327825e-02
## 2014-11-28 0.0065488432 -0.0155413204 0.0006252354 0.004773150 2.710147e-02
## 2014-12-31 0.0014751331 -0.0404420932 -0.0407466668 0.025296292 -2.539852e-03
## 2015-01-30 0.0203148303 -0.0068958692 0.0062264205 -0.054627891 -3.007694e-02
## 2015-02-27 -0.0089881859 0.0431361393 0.0614505257 0.056914279 5.468160e-02
## 2015-03-31 0.0037403430 -0.0150860034 -0.0143887705 0.010156475 -1.583021e-02
## 2015-04-30 -0.0032327453 0.0662812503 0.0358164447 -0.018417908 9.785728e-03
## 2015-05-29 -0.0043838829 -0.0419110105 0.0019528240 0.007510106 1.277425e-02
## 2015-06-30 -0.0108253603 -0.0297467767 -0.0316788242 0.004171395 -2.052117e-02
## 2015-07-31 0.0085845948 -0.0651781469 0.0201145878 -0.027375257 2.233798e-02
## 2015-08-31 -0.0033638714 -0.0925123646 -0.0771525110 -0.047268676 -6.288668e-02
## 2015-09-30 0.0080817171 -0.0318248641 -0.0451947802 -0.038464704 -2.584693e-02
## 2015-10-30 0.0006849032 0.0618081371 0.0640257170 0.063590001 8.163469e-02
## 2015-11-30 -0.0038978451 -0.0255601917 -0.0075557185 0.024415032 3.648420e-03
## 2015-12-31 -0.0019191333 -0.0389472223 -0.0235952834 -0.052156893 -1.743337e-02
## 2016-01-29 0.0123299424 -0.0516366854 -0.0567575807 -0.060306918 -5.106870e-02
## 2016-02-29 0.0088318079 -0.0082114622 -0.0339138891 0.020605024 -8.263631e-04
## 2016-03-31 0.0087087853 0.1218789326 0.0637455859 0.089910547 6.510010e-02
## 2016-04-29 0.0025463165 0.0040791553 0.0219752057 0.021044270 3.933700e-03
## 2016-05-31 0.0001353226 -0.0376284298 -0.0008562266 0.004397173 1.686831e-02
## 2016-06-30 0.0191670922 0.0445825667 -0.0244914741 0.008292248 3.470051e-03
## 2016-07-29 0.0054293264 0.0524421736 0.0390001375 0.049348244 3.582171e-02
## 2016-08-31 -0.0021563165 0.0087982516 0.0053269864 0.011261265 1.196957e-03
## 2016-09-30 0.0005159355 0.0248728798 0.0132791048 0.008614693 5.813242e-05
## 2016-10-31 -0.0082054793 -0.0083120145 -0.0224037254 -0.038134903 -1.748941e-02
## 2016-11-30 -0.0259888346 -0.0451619106 -0.0179743636 0.125246339 3.617627e-02
## 2016-12-30 0.0025379195 -0.0025299619 0.0267028055 0.031491618 2.006916e-02
## 2017-01-31 0.0021261719 0.0644312926 0.0323820778 -0.012143846 1.773642e-02
## 2017-02-28 0.0064378018 0.0172581329 0.0118363991 0.013428831 3.853918e-02
## 2017-03-31 -0.0005532634 0.0361888750 0.0318055938 -0.006533324 1.248989e-03
## 2017-04-28 0.0090293613 0.0168662832 0.0239521597 0.005107994 9.877396e-03
## 2017-05-31 0.0068472278 0.0280597701 0.0348103434 -0.022862241 1.401426e-02
## 2017-06-30 -0.0001823110 0.0092240248 0.0029557966 0.029151399 6.354854e-03
## 2017-07-31 0.0033342977 0.0565943842 0.0261880220 0.007481668 2.034564e-02
## 2017-08-31 0.0093693454 0.0232438852 -0.0004483665 -0.027564677 2.913471e-03
## 2017-09-29 -0.0057325830 -0.0004461534 0.0233427206 0.082321896 1.994918e-02
## 2017-10-31 0.0009780326 0.0322783855 0.0166537743 0.005915767 2.329059e-02
## 2017-11-30 -0.0014843164 -0.0038969510 0.0068699360 0.036913618 3.010785e-02
## 2017-12-29 0.0047407508 0.0369256002 0.0133983675 -0.003731754 1.205528e-02covariance_matrix <- cov(asset_returns_wide_tbl)
covariance_matrix## AGG EEM EFA IJS SPY
## AGG 7.398281e-05 0.0001042104 4.178083e-05 -7.811814e-05 -9.031399e-06
## EEM 1.042104e-04 0.0017547111 1.039016e-03 6.437732e-04 6.795425e-04
## EFA 4.178083e-05 0.0010390164 1.064236e-03 6.490282e-04 6.975392e-04
## IJS -7.811814e-05 0.0006437732 6.490282e-04 1.565449e-03 8.290242e-04
## SPY -9.031399e-06 0.0006795425 6.975392e-04 8.290242e-04 7.408270e-04w <- c(0.25, 0.25, 0.2, 0.2, 0.1)
sd_portfolio <- sqrt(t(w) %*% covariance_matrix %*% w)
sd_portfolio## [,1]
## [1,] 0.0234749# Component contribution
component_contribution <- (t(w) %*% covariance_matrix * w) / sd_portfolio[1,1]
component_contribution## AGG EEM EFA IJS SPY
## [1,] 0.0003874105 0.009257149 0.005815625 0.005684468 0.002330247rowSums(component_contribution)## [1] 0.0234749# Component contribution in percentage
component_percentages <- (component_contribution / sd_portfolio[1,1]) %>%
round(3) %>%
as_tibble()
component_percentages## # A tibble: 1 × 5
## AGG EEM EFA IJS SPY
## <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 0.017 0.394 0.248 0.242 0.099component_percentages %>%
as_tibble() %>%
gather(key = "asset", value = "contribution")## # A tibble: 5 × 2
## asset contribution
## <chr> <dbl>
## 1 AGG 0.017
## 2 EEM 0.394
## 3 EFA 0.248
## 4 IJS 0.242
## 5 SPY 0.0994 Component Contribution with a Custom Function
asset_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 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.25,0.25,0.2,0.2,0.1))## # A tibble: 1 × 5
## AGG EEM EFA IJS SPY
## <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 0.017 0.394 0.248 0.242 0.0995 Visualizing Component Contribution
asset_returns_wide_tbl %>%
calculate_component_contribution(w = c(0.25,0.25,0.2,0.2,0.1)) %>%
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.25,0.25,0.2,0.2,0.1)) %>%
gather(key = "asset", value = "contribution") %>%
add_column(weights = c(0.25,0.25,0.2,0.2,0.1)) %>%
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") 
6 Rolling Component Contribution
calculate_comp_contrib_by_window <- function(asset_returns_wide_tbl,
start = 1,
window = 24,
weights) {
# Start date
start_date <- rownames(asset_returns_wide_tbl)[start]
# Define end date
end_date <- rownames(asset_returns_wide_tbl)[start + window]
# Subset df
df_subset <- asset_returns_wide_tbl %>%
rownames_to_column(var = "date") %>%
filter(date >= start_date & date < end_date) %>%
column_to_rownames(var = "date")
# Calculate component contribution
component_percentages <-df_subset %>%
calculate_component_contribution(w = weights)
# Add end date to df
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 AGG EEM EFA IJS SPY
## <date> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 2015-01-30 0.039 0.372 0.256 0.245 0.088asset_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 AGG EEM EFA IJS SPY
## <date> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 2015-02-27 0.036 0.374 0.249 0.252 0.089dump(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 AGG EEM EFA IJS SPY
## <date> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 2015-01-30 0.039 0.372 0.256 0.245 0.088
## 2 2015-02-27 0.036 0.374 0.249 0.252 0.089
## 3 2015-03-31 0.027 0.37 0.255 0.255 0.092
## 4 2015-04-30 0.027 0.372 0.256 0.252 0.093
## 5 2015-05-29 0.024 0.385 0.254 0.246 0.092
## 6 2015-06-30 0.018 0.383 0.248 0.257 0.094
## 7 2015-07-31 0.014 0.375 0.253 0.261 0.096
## 8 2015-08-31 0.013 0.404 0.237 0.257 0.09
## 9 2015-09-30 0.012 0.407 0.248 0.238 0.094
## 10 2015-10-30 0.003 0.405 0.244 0.243 0.105
## # … with 26 more rowsrolling_comp_contrib_tbl %>%
# Transform data to long form
pivot_longer(cols = -date, names_to = "asset", values_to = "contribution") %>%
# Plot
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("AGG dips below zero sometimes, indicating
it reduces the portfolio volatility."))
rolling_comp_contrib_tbl %>%
# Transform data to long form
pivot_longer(cols = -date, names_to = "asset", values_to = "contribution") %>%
# Plot
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("AGG dips below zero sometimes, indicating
it reduces the portfolio volatility."))